From bf39c0d8b53c8899fb81a9515da91a004d25ec0b Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Fri, 23 Jun 2023 14:51:39 +0300 Subject: [PATCH 01/12] Added new tests for BLAS-like and BLAS API in utest --- .gitignore | 1 + utest/CMakeLists.txt | 75 + utest/Makefile | 30 +- utest/test_extensions/common.c | 259 +++ utest/test_extensions/common.h | 76 + utest/test_extensions/test_caxpby.c | 631 ++++++++ utest/test_extensions/test_caxpyc.c | 158 ++ utest/test_extensions/test_cgbmv.c | 279 ++++ utest/test_extensions/test_cgeadd.c | 880 +++++++++++ utest/test_extensions/test_cgemm.c | 273 ++++ utest/test_extensions/test_cgemmt.c | 2010 ++++++++++++++++++++++++ utest/test_extensions/test_cgemv_n.c | 340 ++++ utest/test_extensions/test_cgemv_t.c | 1132 +++++++++++++ utest/test_extensions/test_cimatcopy.c | 850 ++++++++++ utest/test_extensions/test_comatcopy.c | 728 +++++++++ utest/test_extensions/test_crot.c | 792 ++++++++++ utest/test_extensions/test_crotg.c | 290 ++++ utest/test_extensions/test_csbmv.c | 606 +++++++ utest/test_extensions/test_cscal.c | 164 ++ utest/test_extensions/test_cspmv.c | 428 +++++ utest/test_extensions/test_ctrmv.c | 266 ++++ utest/test_extensions/test_ctrsv.c | 267 ++++ utest/test_extensions/test_damin.c | 354 +++++ utest/test_extensions/test_daxpby.c | 799 ++++++++++ utest/test_extensions/test_dgeadd.c | 878 +++++++++++ utest/test_extensions/test_dgemmt.c | 1442 +++++++++++++++++ utest/test_extensions/test_dimatcopy.c | 947 +++++++++++ utest/test_extensions/test_domatcopy.c | 672 ++++++++ utest/test_extensions/test_drotmg.c | 414 +++++ utest/test_extensions/test_dsum.c | 403 +++++ utest/test_extensions/test_dzamax.c | 294 ++++ utest/test_extensions/test_dzamin.c | 310 ++++ utest/test_extensions/test_dzsum.c | 403 +++++ utest/test_extensions/test_icamin.c | 625 ++++++++ utest/test_extensions/test_idamin.c | 787 ++++++++++ utest/test_extensions/test_isamin.c | 787 ++++++++++ utest/test_extensions/test_izamin.c | 625 ++++++++ utest/test_extensions/test_samin.c | 354 +++++ utest/test_extensions/test_saxpby.c | 794 ++++++++++ utest/test_extensions/test_scamax.c | 294 ++++ utest/test_extensions/test_scamin.c | 310 ++++ utest/test_extensions/test_scsum.c | 403 +++++ utest/test_extensions/test_sgeadd.c | 880 +++++++++++ utest/test_extensions/test_sgemmt.c | 1442 +++++++++++++++++ utest/test_extensions/test_simatcopy.c | 947 +++++++++++ utest/test_extensions/test_somatcopy.c | 672 ++++++++ utest/test_extensions/test_srotmg.c | 414 +++++ utest/test_extensions/test_ssum.c | 403 +++++ utest/test_extensions/test_zaxpby.c | 630 ++++++++ utest/test_extensions/test_zaxpyc.c | 159 ++ utest/test_extensions/test_zgbmv.c | 280 ++++ utest/test_extensions/test_zgeadd.c | 880 +++++++++++ utest/test_extensions/test_zgemm.c | 273 ++++ utest/test_extensions/test_zgemmt.c | 2010 ++++++++++++++++++++++++ utest/test_extensions/test_zgemv_n.c | 341 ++++ utest/test_extensions/test_zgemv_t.c | 1136 +++++++++++++ utest/test_extensions/test_zimatcopy.c | 850 ++++++++++ utest/test_extensions/test_zomatcopy.c | 745 +++++++++ utest/test_extensions/test_zrot.c | 790 ++++++++++ utest/test_extensions/test_zrotg.c | 290 ++++ utest/test_extensions/test_zsbmv.c | 606 +++++++ utest/test_extensions/test_zscal.c | 165 ++ utest/test_extensions/test_zspmv.c | 427 +++++ utest/test_extensions/test_ztrmv.c | 266 ++++ utest/test_extensions/test_ztrsv.c | 267 ++++ utest/test_extensions/xerbla.c | 88 ++ 66 files changed, 37387 insertions(+), 4 deletions(-) create mode 100644 utest/test_extensions/common.c create mode 100644 utest/test_extensions/common.h create mode 100644 utest/test_extensions/test_caxpby.c create mode 100644 utest/test_extensions/test_caxpyc.c create mode 100644 utest/test_extensions/test_cgbmv.c create mode 100644 utest/test_extensions/test_cgeadd.c create mode 100644 utest/test_extensions/test_cgemm.c create mode 100644 utest/test_extensions/test_cgemmt.c create mode 100644 utest/test_extensions/test_cgemv_n.c create mode 100644 utest/test_extensions/test_cgemv_t.c create mode 100644 utest/test_extensions/test_cimatcopy.c create mode 100644 utest/test_extensions/test_comatcopy.c create mode 100644 utest/test_extensions/test_crot.c create mode 100644 utest/test_extensions/test_crotg.c create mode 100644 utest/test_extensions/test_csbmv.c create mode 100644 utest/test_extensions/test_cscal.c create mode 100644 utest/test_extensions/test_cspmv.c create mode 100644 utest/test_extensions/test_ctrmv.c create mode 100644 utest/test_extensions/test_ctrsv.c create mode 100644 utest/test_extensions/test_damin.c create mode 100644 utest/test_extensions/test_daxpby.c create mode 100644 utest/test_extensions/test_dgeadd.c create mode 100644 utest/test_extensions/test_dgemmt.c create mode 100644 utest/test_extensions/test_dimatcopy.c create mode 100644 utest/test_extensions/test_domatcopy.c create mode 100644 utest/test_extensions/test_drotmg.c create mode 100644 utest/test_extensions/test_dsum.c create mode 100644 utest/test_extensions/test_dzamax.c create mode 100644 utest/test_extensions/test_dzamin.c create mode 100644 utest/test_extensions/test_dzsum.c create mode 100644 utest/test_extensions/test_icamin.c create mode 100644 utest/test_extensions/test_idamin.c create mode 100644 utest/test_extensions/test_isamin.c create mode 100644 utest/test_extensions/test_izamin.c create mode 100644 utest/test_extensions/test_samin.c create mode 100644 utest/test_extensions/test_saxpby.c create mode 100644 utest/test_extensions/test_scamax.c create mode 100644 utest/test_extensions/test_scamin.c create mode 100644 utest/test_extensions/test_scsum.c create mode 100644 utest/test_extensions/test_sgeadd.c create mode 100644 utest/test_extensions/test_sgemmt.c create mode 100644 utest/test_extensions/test_simatcopy.c create mode 100644 utest/test_extensions/test_somatcopy.c create mode 100644 utest/test_extensions/test_srotmg.c create mode 100644 utest/test_extensions/test_ssum.c create mode 100644 utest/test_extensions/test_zaxpby.c create mode 100644 utest/test_extensions/test_zaxpyc.c create mode 100644 utest/test_extensions/test_zgbmv.c create mode 100644 utest/test_extensions/test_zgeadd.c create mode 100644 utest/test_extensions/test_zgemm.c create mode 100644 utest/test_extensions/test_zgemmt.c create mode 100644 utest/test_extensions/test_zgemv_n.c create mode 100644 utest/test_extensions/test_zgemv_t.c create mode 100644 utest/test_extensions/test_zimatcopy.c create mode 100644 utest/test_extensions/test_zomatcopy.c create mode 100644 utest/test_extensions/test_zrot.c create mode 100644 utest/test_extensions/test_zrotg.c create mode 100644 utest/test_extensions/test_zsbmv.c create mode 100644 utest/test_extensions/test_zscal.c create mode 100644 utest/test_extensions/test_zspmv.c create mode 100644 utest/test_extensions/test_ztrmv.c create mode 100644 utest/test_extensions/test_ztrsv.c create mode 100644 utest/test_extensions/xerbla.c diff --git a/.gitignore b/.gitignore index 0fe20ecaa..e3e783c46 100644 --- a/.gitignore +++ b/.gitignore @@ -46,6 +46,7 @@ config_last.h getarch getarch_2nd utest/openblas_utest +utest/openblas_utest_ext ctest/xccblat1 ctest/xccblat2 ctest/xccblat3 diff --git a/utest/CMakeLists.txt b/utest/CMakeLists.txt index 2e32827d3..d78701707 100644 --- a/utest/CMakeLists.txt +++ b/utest/CMakeLists.txt @@ -18,6 +18,69 @@ else () ) endif () + +set(DIR_EXT test_extensions) +set(OpenBLAS_utest_ext_src +utest_main.c +${DIR_EXT}/xerbla.c +${DIR_EXT}/test_isamin.c +${DIR_EXT}/test_idamin.c +${DIR_EXT}/test_icamin.c +${DIR_EXT}/test_izamin.c +${DIR_EXT}/test_ssum.c +${DIR_EXT}/test_dsum.c +${DIR_EXT}/test_scsum.c +${DIR_EXT}/test_dzsum.c +${DIR_EXT}/test_samin.c +${DIR_EXT}/test_damin.c +${DIR_EXT}/test_scamin.c +${DIR_EXT}/test_dzamin.c +${DIR_EXT}/test_scamax.c +${DIR_EXT}/test_dzamax.c +${DIR_EXT}/test_zrotg.c +${DIR_EXT}/test_crotg.c +$(DIR_EXT)/test_drotmg.c +$(DIR_EXT)/test_srotmg.c +$(DIR_EXT)/test_zscal.c +$(DIR_EXT)/test_cscal.c +$(DIR_EXT)/test_domatcopy.c +$(DIR_EXT)/test_somatcopy.c +$(DIR_EXT)/test_zomatcopy.c +$(DIR_EXT)/test_comatcopy.c +${DIR_EXT}/test_simatcopy.c +${DIR_EXT}/test_dimatcopy.c +${DIR_EXT}/test_cimatcopy.c +${DIR_EXT}/test_zimatcopy.c +${DIR_EXT}/test_sgeadd.c +${DIR_EXT}/test_dgeadd.c +${DIR_EXT}/test_cgeadd.c +${DIR_EXT}/test_zgeadd.c +${DIR_EXT}/test_saxpby.c +${DIR_EXT}/test_daxpby.c +${DIR_EXT}/test_caxpby.c +${DIR_EXT}/test_zaxpby.c +${DIR_EXT}/test_caxpyc.c +${DIR_EXT}/test_zaxpyc.c +$(DIR_EXT)/test_cgemv_t.c +$(DIR_EXT)/test_zgemv_t.c +$(DIR_EXT)/test_cgemv_n.c +$(DIR_EXT)/test_zgemv_n.c +${DIR_EXT}/test_crot.c +${DIR_EXT}/test_zrot.c +${DIR_EXT}/test_cgbmv.c +${DIR_EXT}/test_zgbmv.c +${DIR_EXT}/test_dgemmt.c +${DIR_EXT}/test_sgemmt.c +${DIR_EXT}/test_cgemmt.c +${DIR_EXT}/test_zgemmt.c +${DIR_EXT}/test_ztrmv.c +${DIR_EXT}/test_ctrmv.c +$(DIR_EXT)/test_ztrsv.c +$(DIR_EXT)/test_ctrsv.c +$(DIR_EXT)/test_zgemm.c +$(DIR_EXT)/test_cgemm.c +) + # crashing on travis cl with an error code suggesting resource not found if (NOT MSVC) set(OpenBLAS_utest_src @@ -46,6 +109,13 @@ set(OpenBLAS_utest_src ${OpenBLAS_utest_src} test_potrs.c ) +set(OpenBLAS_utest_ext_src + ${OpenBLAS_utest_ext_src} + ${DIR_EXT}/test_cspmv.c + ${DIR_EXT}/test_zspmv.c + ${DIR_EXT}/test_csbmv.c + ${DIR_EXT}/test_zsbmv.c + ) if (NOT NO_CBLAS AND NOT NO_LAPACKE) set(OpenBLAS_utest_src ${OpenBLAS_utest_src} @@ -57,7 +127,11 @@ endif() set(OpenBLAS_utest_bin openblas_utest) add_executable(${OpenBLAS_utest_bin} ${OpenBLAS_utest_src}) +set(OpenBLAS_utest_ext_bin openblas_utest_ext) +add_executable(${OpenBLAS_utest_ext_bin} ${OpenBLAS_utest_ext_src}) + target_link_libraries(${OpenBLAS_utest_bin} ${OpenBLAS_LIBNAME}) +target_link_libraries(${OpenBLAS_utest_ext_bin} ${OpenBLAS_LIBNAME}) if(${CMAKE_SYSTEM_NAME} MATCHES "Linux" OR ${CMAKE_SYSTEM_NAME} MATCHES "FreeBSD" OR ${CMAKE_SYSTEM_NAME} MATCHES "QNX" ) target_link_libraries(${OpenBLAS_utest_bin} m) @@ -82,3 +156,4 @@ add_custom_command(TARGET ${OpenBLAS_utest_bin} endif() add_test(${OpenBLAS_utest_bin} ${CMAKE_CURRENT_BINARY_DIR}/${OpenBLAS_utest_bin}) +add_test(${OpenBLAS_utest_ext_bin} ${CMAKE_CURRENT_BINARY_DIR}/${OpenBLAS_utest_bin}) diff --git a/utest/Makefile b/utest/Makefile index f99035440..55561c770 100644 --- a/utest/Makefile +++ b/utest/Makefile @@ -1,21 +1,38 @@ UTEST_CHECK = 1 TOPDIR = .. +DIR_EXT=test_extensions override TARGET_ARCH= override TARGET_MACH= UTESTBIN=openblas_utest +UTESTEXTBIN=openblas_utest_ext .PHONY : all -.NOTPARALLEL : all run_test $(UTESTBIN) +.NOTPARALLEL : all run_test $(UTESTBIN) $(UTESTEXTBIN) include $(TOPDIR)/Makefile.system OBJS=utest_main.o test_min.o test_amax.o test_ismin.o test_rotmg.o test_axpy.o test_dotu.o test_dsdot.o test_swap.o test_rot.o test_dnrm2.o #test_rot.o test_swap.o test_axpy.o test_dotu.o test_dsdot.o test_fork.o +OBJS_EXT=utest_main.o $(DIR_EXT)/xerbla.o $(DIR_EXT)/common.o +OBJS_EXT+=$(DIR_EXT)/test_isamin.o $(DIR_EXT)/test_idamin.o $(DIR_EXT)/test_icamin.o $(DIR_EXT)/test_izamin.o +OBJS_EXT+=$(DIR_EXT)/test_ssum.o $(DIR_EXT)/test_dsum.o $(DIR_EXT)/test_scsum.o $(DIR_EXT)/test_dzsum.o +OBJS_EXT+=$(DIR_EXT)/test_saxpby.o $(DIR_EXT)/test_daxpby.o $(DIR_EXT)/test_caxpby.o $(DIR_EXT)/test_zaxpby.o $(DIR_EXT)/test_zaxpyc.o $(DIR_EXT)/test_caxpyc.o +OBJS_EXT+=$(DIR_EXT)/test_samin.o $(DIR_EXT)/test_damin.o $(DIR_EXT)/test_scamin.o $(DIR_EXT)/test_dzamin.o $(DIR_EXT)/test_scamax.o $(DIR_EXT)/test_dzamax.o +OBJS_EXT+=$(DIR_EXT)/test_drotmg.o $(DIR_EXT)/test_srotmg.o $(DIR_EXT)/test_zrotg.o $(DIR_EXT)/test_crotg.o $(DIR_EXT)/test_crot.o $(DIR_EXT)/test_zrot.o +OBJS_EXT+=$(DIR_EXT)/test_zscal.o $(DIR_EXT)/test_cscal.o +OBJS_EXT+=$(DIR_EXT)/test_domatcopy.o $(DIR_EXT)/test_somatcopy.o $(DIR_EXT)/test_zomatcopy.o $(DIR_EXT)/test_comatcopy.o +OBJS_EXT+=$(DIR_EXT)/test_simatcopy.o $(DIR_EXT)/test_dimatcopy.o $(DIR_EXT)/test_cimatcopy.o $(DIR_EXT)/test_zimatcopy.o +OBJS_EXT+=$(DIR_EXT)/test_sgeadd.o $(DIR_EXT)/test_dgeadd.o $(DIR_EXT)/test_cgeadd.o $(DIR_EXT)/test_zgeadd.o +OBJS_EXT+=$(DIR_EXT)/test_cgemv_t.o $(DIR_EXT)/test_zgemv_t.o $(DIR_EXT)/test_cgemv_n.o $(DIR_EXT)/test_zgemv_n.o +OBJS_EXT+=$(DIR_EXT)/test_sgemmt.o $(DIR_EXT)/test_dgemmt.o $(DIR_EXT)/test_cgemmt.o $(DIR_EXT)/test_zgemmt.o +OBJS_EXT+=$(DIR_EXT)/test_ztrmv.o $(DIR_EXT)/test_ctrmv.o $(DIR_EXT)/test_ztrsv.o $(DIR_EXT)/test_ctrsv.o +OBJS_EXT+=$(DIR_EXT)/test_zgemm.o $(DIR_EXT)/test_cgemm.o $(DIR_EXT)/test_zgbmv.o $(DIR_EXT)/test_cgbmv.o ifneq ($(NO_LAPACK), 1) OBJS += test_potrs.o +OBJS_EXT += $(DIR_EXT)/test_zspmv.o $(DIR_EXT)/test_cspmv.o $(DIR_EXT)/test_zsbmv.o $(DIR_EXT)/test_csbmv.o ifneq ($(NO_CBLAS), 1) ifneq ($(NO_LAPACKE), 1) OBJS += test_kernel_regress.o @@ -47,12 +64,17 @@ all : run_test $(UTESTBIN): $(OBJS) $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) $(FEXTRALIB) -run_test: $(UTESTBIN) +$(UTESTEXTBIN): $(OBJS_EXT) + $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) $(FEXTRALIB) + +run_test: $(UTESTBIN) $(UTESTEXTBIN) ifneq ($(CROSS), 1) ./$(UTESTBIN) + ./$(UTESTEXTBIN) endif clean: - -rm -f *.o $(UTESTBIN) + -rm -f *.o $(UTESTBIN) $(UTESTEXTBIN) + -rm -f $(DIR_EXT)/*.o -libs: +libs: \ No newline at end of file diff --git a/utest/test_extensions/common.c b/utest/test_extensions/common.c new file mode 100644 index 000000000..c3bdcefc7 --- /dev/null +++ b/utest/test_extensions/common.c @@ -0,0 +1,259 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "common.h" + +/** + * Generate random array + */ +void srand_generate(float *alpha, blasint n) +{ + blasint i; + for (i = 0; i < n; i++) + alpha[i] = (float)rand() / (float)RAND_MAX * 5.0f; +} + +void drand_generate(double *alpha, blasint n) +{ + blasint i; + for (i = 0; i < n; i++) + alpha[i] = (double)rand() / (double)RAND_MAX * 5.0; +} + +/** + * Find difference between two rectangle matrix + * return norm of differences + */ +float smatrix_difference(float *a, float *b, blasint cols, blasint rows, blasint ld) +{ + blasint i = 0; + blasint j = 0; + blasint inc = 1; + float norm = 0.0f; + + float *a_ptr = a; + float *b_ptr = b; + + for(i = 0; i < rows; i++) + { + for (j = 0; j < cols; j++) { + a_ptr[j] -= b_ptr[j]; + } + norm += cblas_snrm2(cols, a_ptr, inc); + + a_ptr += ld; + b_ptr += ld; + } + return norm/(float)(rows); +} + +double dmatrix_difference(double *a, double *b, blasint cols, blasint rows, blasint ld) +{ + blasint i = 0; + blasint j = 0; + blasint inc = 1; + double norm = 0.0; + + double *a_ptr = a; + double *b_ptr = b; + + for(i = 0; i < rows; i++) + { + for (j = 0; j < cols; j++) { + a_ptr[j] -= b_ptr[j]; + } + norm += cblas_dnrm2(cols, a_ptr, inc); + + a_ptr += ld; + b_ptr += ld; + } + return norm/(double)(rows); +} + +/** + * Complex conjugate operation for vector + * + * param n specifies number of elements in vector x + * param inc_x specifies increment of vector x + * param x_ptr specifies buffer holding vector x + */ +void cconjugate_vector(blasint n, blasint inc_x, float *x_ptr) +{ + blasint i; + inc_x *= 2; + + for (i = 0; i < n; i++) + { + x_ptr[1] *= (-1.0f); + x_ptr += inc_x; + } +} + +void zconjugate_vector(blasint n, blasint inc_x, double *x_ptr) +{ + blasint i; + inc_x *= 2; + + for (i = 0; i < n; i++) + { + x_ptr[1] *= (-1.0); + x_ptr += inc_x; + } +} + +/** + * Transpose matrix + * + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param alpha specifies scaling factor for matrix A + * param a_src - buffer holding input matrix A + * param lda_src - leading dimension of the matrix A + * param a_dst - buffer holding output matrix A + * param lda_dst - leading dimension of output matrix A + */ +void stranspose(blasint rows, blasint cols, float alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst) +{ + blasint i, j; + for (i = 0; i != cols; i++) + { + for (j = 0; j != rows; j++) + a_dst[i*lda_dst+j] = alpha*a_src[j*lda_src+i]; + } +} + +void dtranspose(blasint rows, blasint cols, double alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst) +{ + blasint i, j; + for (i = 0; i != cols; i++) + { + for (j = 0; j != rows; j++) + a_dst[i*lda_dst+j] = alpha*a_src[j*lda_src+i]; + } +} + +void ctranspose(blasint rows, blasint cols, float *alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst, int conj) +{ + blasint i, j; + lda_dst *= 2; + lda_src *= 2; + for (i = 0; i != cols*2; i+=2) + { + for (j = 0; j != rows*2; j+=2){ + a_dst[(i/2)*lda_dst+j] = alpha[0] * a_src[(j/2)*lda_src+i] + conj * alpha[1] * a_src[(j/2)*lda_src+i+1]; + a_dst[(i/2)*lda_dst+j+1] = (-1.0f) * conj * alpha[0] * a_src[(j/2)*lda_src+i+1] + alpha[1] * a_src[(j/2)*lda_src+i]; + } + } +} + +void ztranspose(blasint rows, blasint cols, double *alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst, int conj) +{ + blasint i, j; + lda_dst *= 2; + lda_src *= 2; + for (i = 0; i != cols*2; i+=2) + { + for (j = 0; j != rows*2; j+=2){ + a_dst[(i/2)*lda_dst+j] = alpha[0] * a_src[(j/2)*lda_src+i] + conj * alpha[1] * a_src[(j/2)*lda_src+i+1]; + a_dst[(i/2)*lda_dst+j+1] = (-1.0) * conj * alpha[0] * a_src[(j/2)*lda_src+i+1] + alpha[1] * a_src[(j/2)*lda_src+i]; + } + } +} + +/** + * Copy matrix from source A to destination A + * + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param alpha specifies scaling factor for matrix A + * param a_src - buffer holding input matrix A + * param lda_src - leading dimension of the matrix A + * param a_dst - buffer holding output matrix A + * param lda_dst - leading dimension of output matrix A + * param conj specifies conjugation + */ +void scopy(blasint rows, blasint cols, float alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst) +{ + blasint i, j; + for (i = 0; i != rows; i++) + { + for (j = 0; j != cols; j++) + a_dst[i*lda_dst+j] = alpha*a_src[i*lda_src+j]; + } +} + +void dcopy(blasint rows, blasint cols, double alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst) +{ + blasint i, j; + for (i = 0; i != rows; i++) + { + for (j = 0; j != cols; j++) + a_dst[i*lda_dst+j] = alpha*a_src[i*lda_src+j]; + } +} + +void ccopy(blasint rows, blasint cols, float *alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst, int conj) +{ + blasint i, j; + lda_dst *= 2; + lda_src *= 2; + for (i = 0; i != rows; i++) + { + for (j = 0; j != cols*2; j+=2){ + a_dst[i*lda_dst+j] = alpha[0] * a_src[i*lda_src+j] + conj * alpha[1] * a_src[i*lda_src+j+1]; + a_dst[i*lda_dst+j+1] = (-1.0f) * conj *alpha[0] * a_src[i*lda_src+j+1] + alpha[1] * a_src[i*lda_src+j]; + } + } +} + +void zcopy(blasint rows, blasint cols, double *alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst, int conj) +{ + blasint i, j; + lda_dst *= 2; + lda_src *= 2; + for (i = 0; i != rows; i++) + { + for (j = 0; j != cols*2; j+=2){ + a_dst[i*lda_dst+j] = alpha[0] * a_src[i*lda_src+j] + conj * alpha[1] * a_src[i*lda_src+j+1]; + a_dst[i*lda_dst+j+1] = (-1.0) * conj *alpha[0] * a_src[i*lda_src+j+1] + alpha[1] * a_src[i*lda_src+j]; + } + } +} \ No newline at end of file diff --git a/utest/test_extensions/common.h b/utest/test_extensions/common.h new file mode 100644 index 000000000..62b84325c --- /dev/null +++ b/utest/test_extensions/common.h @@ -0,0 +1,76 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#ifndef _TEST_EXTENSION_COMMON_H_ +#define _TEST_EXTENSION_COMMON_H_ + +#include +#include + +#define TRUE 1 +#define FALSE 0 +#define INVALID -1 +#define SINGLE_TOL 1e-02f +#define DOUBLE_TOL 1e-10 + +extern int check_error(void); +extern void set_xerbla(char* current_rout, int expected_info); +extern int BLASFUNC(xerbla)(char *name, blasint *info, blasint length); + +extern void srand_generate(float *alpha, blasint n); +extern void drand_generate(double *alpha, blasint n); + +extern float smatrix_difference(float *a, float *b, blasint cols, blasint rows, blasint ld); +extern double dmatrix_difference(double *a, double *b, blasint cols, blasint rows, blasint ld); + +extern void cconjugate_vector(blasint n, blasint inc_x, float *x_ptr); +extern void zconjugate_vector(blasint n, blasint inc_x, double *x_ptr); + +extern void stranspose(blasint rows, blasint cols, float alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst); +extern void dtranspose(blasint rows, blasint cols, double alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst); +extern void ctranspose(blasint rows, blasint cols, float *alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst, int conj); +extern void ztranspose(blasint rows, blasint cols, double *alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst, int conj); + +extern void scopy(blasint rows, blasint cols, float alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst); +extern void dcopy(blasint rows, blasint cols, double alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst); +extern void ccopy(blasint rows, blasint cols, float *alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst, int conj); +extern void zcopy(blasint rows, blasint cols, double *alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst, int conj); +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_caxpby.c b/utest/test_extensions/test_caxpby.c new file mode 100644 index 000000000..221a48ac7 --- /dev/null +++ b/utest/test_extensions/test_caxpby.c @@ -0,0 +1,631 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CAXPBY { + float x_test[DATASIZE * INCREMENT * 2]; + float x_verify[DATASIZE * INCREMENT * 2]; + float y_test[DATASIZE * INCREMENT * 2]; + float y_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CAXPBY data_caxpby; + +/** + * Fortran API specific function + * Test caxpby by comparing it with cscal and caxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static float check_caxpby(blasint n, float *alpha, blasint incx, float *beta, blasint incy) +{ + blasint i; + + // cscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Fill vectors x, y + srand_generate(data_caxpby.x_test, n * incx_abs * 2); + srand_generate(data_caxpby.y_test, n * incy_abs * 2); + + // Copy vector x for caxpy + for (i = 0; i < n * incx_abs * 2; i++) + data_caxpby.x_verify[i] = data_caxpby.x_test[i]; + + // Copy vector y for cscal + for (i = 0; i < n * incy_abs * 2; i++) + data_caxpby.y_verify[i] = data_caxpby.y_test[i]; + + // Find beta*y + BLASFUNC(cscal)(&n, beta, data_caxpby.y_verify, &incy_abs); + + // Find sum of alpha*x and beta*y + BLASFUNC(caxpy)(&n, alpha, data_caxpby.x_verify, &incx, + data_caxpby.y_verify, &incy); + + BLASFUNC(caxpby)(&n, alpha, data_caxpby.x_test, &incx, + beta, data_caxpby.y_test, &incy); + + // Find the differences between output vector caculated by caxpby and caxpy + for (i = 0; i < n * incy_abs * 2; i++) + data_caxpby.y_test[i] -= data_caxpby.y_verify[i]; + + // Find the norm of differences + return BLASFUNC(scnrm2)(&n, data_caxpby.y_test, &incy_abs); +} + +/** + * C API specific function + * Test caxpby by comparing it with cscal and caxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static float c_api_check_caxpby(blasint n, float *alpha, blasint incx, float *beta, blasint incy) +{ + blasint i; + + // cscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Fill vectors x, y + srand_generate(data_caxpby.x_test, n * incx_abs * 2); + srand_generate(data_caxpby.y_test, n * incy_abs * 2); + + // Copy vector x for caxpy + for (i = 0; i < n * incx_abs * 2; i++) + data_caxpby.x_verify[i] = data_caxpby.x_test[i]; + + // Copy vector y for cscal + for (i = 0; i < n * incy_abs * 2; i++) + data_caxpby.y_verify[i] = data_caxpby.y_test[i]; + + // Find beta*y + cblas_cscal(n, beta, data_caxpby.y_verify, incy_abs); + + // Find sum of alpha*x and beta*y + cblas_caxpy(n, alpha, data_caxpby.x_verify, incx, + data_caxpby.y_verify, incy); + + cblas_caxpby(n, alpha, data_caxpby.x_test, incx, + beta, data_caxpby.y_test, incy); + + // Find the differences between output vector caculated by caxpby and caxpy + for (i = 0; i < n * incy_abs * 2; i++) + data_caxpby.y_test[i] -= data_caxpby.y_verify[i]; + + // Find the norm of differences + return cblas_scnrm2(n, data_caxpby.y_test, incy_abs); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(caxpby, inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(caxpby, inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(caxpby, inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(caxpby, inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha[] = {3.0f, 1.0f}; + float beta[] = {4.0f, 3.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(caxpby, inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + float alpha[] = {5.0f, 2.2f}; + float beta[] = {4.0f, 5.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(caxpby, inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {6.0f, 3.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(caxpby, inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + float alpha[] = {7.0f, 2.0f}; + float beta[] = {3.5f, 1.3f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(caxpby, inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(caxpby, inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(caxpby, inc_x_1_inc_y_1_N_100_a_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(caxpby, inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(caxpby, check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(caxpby, c_api_inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(caxpby, c_api_inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(caxpby, c_api_inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 2.1f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(caxpby, c_api_inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha[] = {3.0f, 2.0f}; + float beta[] = {4.0f, 3.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(caxpby, c_api_inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + float alpha[] = {5.0f, 2.0f}; + float beta[] = {4.0f, 3.1f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(caxpby, c_api_inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {6.0f, 2.3f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(caxpby, c_api_inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + float alpha[] = {7.0f, 1.0f}; + float beta[] = {3.5f, 1.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(caxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(caxpby, c_api_inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(caxpby, c_api_inc_x_1_inc_y_1_N_100_a_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(caxpby, c_api_inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(caxpby, c_api_check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif diff --git a/utest/test_extensions/test_caxpyc.c b/utest/test_extensions/test_caxpyc.c new file mode 100644 index 000000000..ed1899e57 --- /dev/null +++ b/utest/test_extensions/test_caxpyc.c @@ -0,0 +1,158 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CAXPYC { + float x_test[DATASIZE * INCREMENT * 2]; + float x_verify[DATASIZE * INCREMENT * 2]; + float y_test[DATASIZE * INCREMENT * 2]; + float y_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CAXPYC data_caxpyc; + +/** + * Test caxpyc by conjugating vector x and comparing with caxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param incy - increment for the elements of y + * return norm of difference + */ +static float check_caxpyc(blasint n, float *alpha, blasint incx, blasint incy) +{ + blasint i; + + srand_generate(data_caxpyc.x_test, n * incx * 2); + srand_generate(data_caxpyc.y_test, n * incy * 2); + + for (i = 0; i < n * incx * 2; i++) + data_caxpyc.x_verify[i] = data_caxpyc.x_test[i]; + + for (i = 0; i < n * incy * 2; i++) + data_caxpyc.y_verify[i] = data_caxpyc.y_test[i]; + + cconjugate_vector(n, incx, data_caxpyc.x_verify); + + BLASFUNC(caxpy)(&n, alpha, data_caxpyc.x_verify, &incx, + data_caxpyc.y_verify, &incy); + + BLASFUNC(caxpyc)(&n, alpha, data_caxpyc.x_test, &incx, + data_caxpyc.y_test, &incy); + + for (i = 0; i < n * incy * 2; i++) + data_caxpyc.y_verify[i] -= data_caxpyc.y_test[i]; + + return BLASFUNC(scnrm2)(&n, data_caxpyc.y_verify, &incy); +} + +/** + * Test caxpyc by conjugating vector x and comparing with caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(caxpyc, conj_strides_one) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {5.0f, 2.2f}; + + float norm = check_caxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test caxpyc by conjugating vector x and comparing with caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(caxpyc, conj_incx_one) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha[] = {5.0f, 2.2f}; + + float norm = check_caxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test caxpyc by conjugating vector x and comparing with caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(caxpyc, conj_incy_one) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha[] = {5.0f, 2.2f}; + + float norm = check_caxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test caxpyc by conjugating vector x and comparing with caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(caxpyc, conj_strides_two) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha[] = {5.0f, 2.2f}; + + float norm = check_caxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif diff --git a/utest/test_extensions/test_cgbmv.c b/utest/test_extensions/test_cgbmv.c new file mode 100644 index 000000000..8e0640c5d --- /dev/null +++ b/utest/test_extensions/test_cgbmv.c @@ -0,0 +1,279 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 1 + +struct DATA_CGBMV { + float a_test[DATASIZE * DATASIZE * 2]; + float a_band_storage[DATASIZE * DATASIZE * 2]; + float matrix[DATASIZE * DATASIZE * 2]; + float b_test[DATASIZE * 2 * INCREMENT]; + float c_test[DATASIZE * 2 * INCREMENT]; + float c_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CGBMV data_cgbmv; + +/** + * Transform full-storage band matrix A to band-packed storage mode. + * + * param m - number of rows of A + * param n - number of columns of A + * param kl - number of sub-diagonals of the matrix A + * param ku - number of super-diagonals of the matrix A + * output param a - buffer for holding band-packed matrix + * param lda - specifies the leading dimension of a + * param matrix - buffer holding full-storage band matrix A + * param ldm - specifies the leading full-storage band matrix A + */ +static void transform_to_band_storage(blasint m, blasint n, blasint kl, + blasint ku, float* a, blasint lda, + float* matrix, blasint ldm) +{ + blasint i, j, k; + for (j = 0; j < n; j++) + { + k = 2 * (ku - j); + for (i = MAX(0, 2*(j - ku)); i < MIN(m, j + kl + 1) * 2; i+=2) + { + a[(k + i) + j * lda * 2] = matrix[i + j * ldm * 2]; + a[(k + i) + j * lda * 2 + 1] = matrix[i + j * ldm * 2 + 1]; + } + } +} + +/** + * Generate full-storage band matrix A with kl sub-diagonals and ku super-diagonals + * + * param m - number of rows of A + * param n - number of columns of A + * param kl - number of sub-diagonals of the matrix A + * param ku - number of super-diagonals of the matrix A + * output param band_matrix - buffer for full-storage band matrix. + * param matrix - buffer holding input general matrix + * param ldm - specifies the leading of input general matrix +*/ +static void get_band_matrix(blasint m, blasint n, blasint kl, blasint ku, + float *band_matrix, float *matrix, blasint ldm) +{ + blasint i, j; + blasint k = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < m * 2; j += 2) + { + if ((blasint)(j/2) > kl + i || i > ku + (blasint)(j/2)) + { + band_matrix[i * ldm * 2 + j] = 0.0f; + band_matrix[i * ldm * 2 + j + 1] = 0.0f; + continue; + } + + band_matrix[i * ldm * 2 + j] = matrix[k++]; + band_matrix[i * ldm * 2 + j + 1] = matrix[k++]; + } + } +} + +/** + * Comapare results computed by cgbmv and cgemv + * since gbmv is gemv for band matrix + * + * param trans specifies op(A), the transposition operation applied to A + * param m - number of rows of A + * param n - number of columns of A + * param kl - number of sub-diagonals of the matrix A + * param ku - number of super-diagonals of the matrix A + * param alpha - scaling factor for the matrix-vector product + * param lda - specifies the leading dimension of a + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param inc_c - stride of vector c + * return norm of differences + */ +static float check_cgbmv(char trans, blasint m, blasint n, blasint kl, blasint ku, + float *alpha, blasint lda, blasint inc_b, float *beta, blasint inc_c) +{ + blasint i; + blasint lenb, lenc; + + if(trans == 'T' || trans == 'C' || trans == 'D' || trans == 'U'){ + lenb = m; + lenc = n; + } else { + lenb = n; + lenc = m; + } + + srand_generate(data_cgbmv.matrix, m * n * 2); + srand_generate(data_cgbmv.b_test, 2 * (1 + (lenb - 1) * inc_b)); + srand_generate(data_cgbmv.c_test, 2 * (1 + (lenc - 1) * inc_c)); + + for (i = 0; i < 2 * (1 + (lenc - 1) * inc_c); i++) + data_cgbmv.c_verify[i] = data_cgbmv.c_test[i]; + + get_band_matrix(m, n, kl, ku, data_cgbmv.a_test, data_cgbmv.matrix, m); + + transform_to_band_storage(m, n, kl, ku, data_cgbmv.a_band_storage, lda, data_cgbmv.a_test, m); + + BLASFUNC(cgemv)(&trans, &m, &n, alpha, data_cgbmv.a_test, &m, data_cgbmv.b_test, + &inc_b, beta, data_cgbmv.c_verify, &inc_c); + + BLASFUNC(cgbmv)(&trans, &m, &n, &kl, &ku, alpha, data_cgbmv.a_band_storage, &lda, data_cgbmv.b_test, + &inc_b, beta, data_cgbmv.c_test, &inc_c); + + for (i = 0; i < 2 * (1 + (lenc - 1) * inc_c); i++) + data_cgbmv.c_verify[i] -= data_cgbmv.c_test[i]; + + return BLASFUNC(scnrm2)(&lenc, data_cgbmv.c_verify, &inc_c); +} + +/** + * Test cgbmv by comparing it against cgemv + * with param trans is D + */ +CTEST(cgbmv, trans_D) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 11; + blasint lda = 50; + char trans = 'D'; + + float alpha[] = {7.0f, 1.0f}; + float beta[] = {1.5f, -1.5f}; + + float norm = check_cgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgbmv by comparing it against cgemv + * with param trans is O + */ +CTEST(cgbmv, trans_O) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 10; + blasint lda = 50; + char trans = 'O'; + + float alpha[] = {7.0f, 1.0f}; + float beta[] = {1.5f, -1.5f}; + + float norm = check_cgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgbmv by comparing it against cgemv + * with param trans is S + */ +CTEST(cgbmv, trans_S) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 6, ku = 9; + blasint lda = 50; + char trans = 'S'; + + float alpha[] = {7.0f, 1.0f}; + float beta[] = {1.5f, -1.5f}; + + float norm = check_cgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgbmv by comparing it against cgemv + * with param trans is U + */ +CTEST(cgbmv, trans_U) +{ + blasint m = 25, n = 50; + blasint inc_b = 1, inc_c = 1; + blasint kl = 7, ku = 11; + blasint lda = kl + ku + 1; + char trans = 'U'; + + float alpha[] = {7.0f, 1.0f}; + float beta[] = {1.5f, -1.5f}; + + float norm = check_cgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgbmv by comparing it against cgemv + * with param trans is C + */ +CTEST(cgbmv, trans_C) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 11; + blasint lda = 50; + char trans = 'C'; + + float alpha[] = {7.0f, 1.0f}; + float beta[] = {1.5f, -1.5f}; + + float norm = check_cgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgbmv by comparing it against cgemv + * with param trans is R + */ +CTEST(cgbmv, trans_R) +{ + blasint m = 50, n = 100; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 11; + blasint lda = 50; + char trans = 'R'; + + float alpha[] = {7.0f, 1.0f}; + float beta[] = {1.5f, -1.5f}; + + float norm = check_cgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} +#endif diff --git a/utest/test_extensions/test_cgeadd.c b/utest/test_extensions/test_cgeadd.c new file mode 100644 index 000000000..0cf6cbf87 --- /dev/null +++ b/utest/test_extensions/test_cgeadd.c @@ -0,0 +1,880 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define N 100 +#define M 100 + +struct DATA_CGEADD { + float a_test[M * N * 2]; + float c_test[M * N * 2]; + float c_verify[M * N * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CGEADD data_cgeadd; + +/** + * cgeadd reference implementation + * + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param aptr - refer to matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param cptr - refer to matrix C + * param ldc - leading dimension of C + */ +static void cgeadd_trusted(blasint m, blasint n, float *alpha, float *aptr, + blasint lda, float *beta, float *cptr, blasint ldc) +{ + blasint i; + + lda *= 2; + ldc *= 2; + + for (i = 0; i < n; i++) + { + cblas_caxpby(m, alpha, aptr, 1, beta, cptr, 1); + aptr += lda; + cptr += ldc; + } +} + +/** + * Test cgeadd by comparing it against reference + * Compare with the following options: + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static float check_cgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, float *alpha, blasint lda, + float *beta, blasint ldc) +{ + blasint i; + blasint cols = m, rows = n; + + if (order == CblasRowMajor) + { + rows = m; + cols = n; + } + + // Fill matrix A, C + srand_generate(data_cgeadd.a_test, lda * rows * 2); + srand_generate(data_cgeadd.c_test, ldc * rows * 2); + + // Copy matrix C for cgeadd + for (i = 0; i < ldc * rows * 2; i++) + data_cgeadd.c_verify[i] = data_cgeadd.c_test[i]; + + cgeadd_trusted(cols, rows, alpha, data_cgeadd.a_test, lda, + beta, data_cgeadd.c_verify, ldc); + + if (api == 'F') + BLASFUNC(cgeadd)(&m, &n, alpha, data_cgeadd.a_test, &lda, + beta, data_cgeadd.c_test, &ldc); + else + cblas_cgeadd(order, m, n, alpha, data_cgeadd.a_test, lda, + beta, data_cgeadd.c_test, ldc); + + // Find the differences between output matrix caculated by cgeadd and sgemm + return smatrix_difference(data_cgeadd.c_test, data_cgeadd.c_verify, cols, rows, ldc*2); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param lda - leading dimension of A + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in cgeadd + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, blasint lda, + blasint ldc, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + set_xerbla("CGEADD ", expected_info); + + if (api == 'F') + BLASFUNC(cgeadd)(&m, &n, alpha, data_cgeadd.a_test, &lda, + beta, data_cgeadd.c_test, &ldc); + else + cblas_cgeadd(order, m, n, alpha, data_cgeadd.a_test, lda, + beta, data_cgeadd.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(cgeadd, matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {3.0f, 2.0f}; + float beta[] = {1.0f, 3.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(cgeadd, matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.5f, 1.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(cgeadd, matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {3.0f, 1.5f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(cgeadd, matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {0.0f, 0.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(cgeadd, matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param n - + * number of columns of A and C + * Must be at least zero. + */ +CTEST(cgeadd, xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = m; + blasint ldc = m; + + int expected_info = 2; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific tests + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + */ +CTEST(cgeadd, xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + */ +CTEST(cgeadd, xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 6; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + */ +CTEST(cgeadd, xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Check if n - number of columns of A, C equal zero. + */ +CTEST(cgeadd, n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Check if m - number of rows of A and C equal zero. + */ +CTEST(cgeadd, m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(cgeadd, c_api_matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 3.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(cgeadd, c_api_matrix_n_100_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {4.0f, 1.5f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(cgeadd, c_api_matrix_n_50_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N / 2; + blasint m = M; + + blasint lda = n; + blasint ldc = n; + + float alpha[] = {3.0f, 2.5f}; + float beta[] = {1.0f, 2.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(cgeadd, c_api_matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {0.0f, 0.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(cgeadd, c_api_matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {3.0f, 1.5f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(cgeadd, c_api_matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {0.0f, 0.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(cgeadd, c_api_matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {2.0f, 3.0f}; + float beta[] = {2.0f, 4.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test error function for an invalid param order - + * specifies whether A and C stored in + * row-major order or column-major order + */ +CTEST(cgeadd, c_api_xerbla_invalid_order) +{ + CBLAS_ORDER order = INVALID; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 0; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(cgeadd, c_api_xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(cgeadd, c_api_xerbla_n_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(cgeadd, c_api_xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(cgeadd, c_api_xerbla_m_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(cgeadd, c_api_xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(cgeadd, c_api_xerbla_lda_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(cgeadd, c_api_xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(cgeadd, c_api_xerbla_ldc_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Check if n - number of columns of A, C equal zero. + * + * c api option order is column-major order + */ +CTEST(cgeadd, c_api_n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Check if m - number of rows of A and C equal zero. + * + * c api option order is column-major order + */ +CTEST(cgeadd, c_api_m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_cgemm.c b/utest/test_extensions/test_cgemm.c new file mode 100644 index 000000000..cd38d710b --- /dev/null +++ b/utest/test_extensions/test_cgemm.c @@ -0,0 +1,273 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CGEMM { + float a_test[DATASIZE * DATASIZE * 2]; + float a_verify[DATASIZE * DATASIZE * 2]; + float b_test[DATASIZE * DATASIZE * 2]; + float b_verify[DATASIZE * DATASIZE * 2]; + float c_test[DATASIZE * DATASIZE * 2]; + float c_verify[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CGEMM data_cgemm; + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * + * param transa specifies op(A), the transposition (conjugation) operation applied to A + * param transb specifies op(B), the transposition (conjugation) operation applied to B + * param m specifies the number of rows of the matrix op(A) and of the matrix C + * param n specifies the number of columns of the matrix op(B) and the number of columns of the matrix C + * param k specifies the number of columns of the matrix op(A) and the number of rows of the matrix op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of matrix A + * param ldb - leading dimension of matrix B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of matrix C + * return norm of difference + */ +static float check_cgemm(char transa, char transb, blasint m, blasint n, blasint k, + float *alpha, blasint lda, blasint ldb, float *beta, blasint ldc) +{ + blasint i; + float alpha_conj[] = {1.0f, 0.0f}; + char transa_verify = transa; + char transb_verify = transb; + + int arows = k, acols = m; + int brows = n, bcols = k; + + if (transa == 'T' || transa == 'C'){ + arows = m; acols = k; + } + + if (transb == 'T' || transb == 'C'){ + brows = k; bcols = n; + } + + srand_generate(data_cgemm.a_test, arows * lda * 2); + srand_generate(data_cgemm.b_test, brows * ldb * 2); + srand_generate(data_cgemm.c_test, n * ldc * 2); + + for (i = 0; i < arows * lda * 2; i++) + data_cgemm.a_verify[i] = data_cgemm.a_test[i]; + + for (i = 0; i < brows * ldb * 2; i++) + data_cgemm.b_verify[i] = data_cgemm.b_test[i]; + + for (i = 0; i < n * ldc * 2; i++) + data_cgemm.c_verify[i] = data_cgemm.c_test[i]; + + if (transa == 'R'){ + cblas_cimatcopy(CblasColMajor, CblasConjNoTrans, arows, acols, alpha_conj, data_cgemm.a_verify, lda, lda); + transa_verify = 'N'; + } + + if (transb == 'R'){ + cblas_cimatcopy(CblasColMajor, CblasConjNoTrans, brows, bcols, alpha_conj, data_cgemm.b_verify, ldb, ldb); + transb_verify = 'N'; + } + + BLASFUNC(cgemm)(&transa_verify, &transb_verify, &m, &n, &k, alpha, data_cgemm.a_verify, &lda, + data_cgemm.b_verify, &ldb, beta, data_cgemm.c_verify, &ldc); + + BLASFUNC(cgemm)(&transa, &transb, &m, &n, &k, alpha, data_cgemm.a_test, &lda, + data_cgemm.b_test, &ldb, beta, data_cgemm.c_test, &ldc); + + return smatrix_difference(data_cgemm.c_test, data_cgemm.c_verify, m, n, ldc*2); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is conjugate and transposed + * matrix B is conjugate and not transposed + */ +CTEST(cgemm, conjtransa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'C'; + char transb = 'R'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is not conjugate and not transposed + * matrix B is conjugate and not transposed + */ +CTEST(cgemm, notransa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'N'; + char transb = 'R'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is conjugate and transposed + */ +CTEST(cgemm, conjnotransa_conjtransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'C'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is not conjugate and not transposed + */ +CTEST(cgemm, conjnotransa_notransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'N'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is conjugate and not transposed + */ +CTEST(cgemm, conjnotransa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'R'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is transposed + */ +CTEST(cgemm, conjnotransa_transb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'T'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is transposed + * matrix B is conjugate and not transposed + */ +CTEST(cgemm, transa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'T'; + char transb = 'R'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_cgemmt.c b/utest/test_extensions/test_cgemmt.c new file mode 100644 index 000000000..ed9279933 --- /dev/null +++ b/utest/test_extensions/test_cgemmt.c @@ -0,0 +1,2010 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_CGEMMT { + float a_test[DATASIZE * DATASIZE * 2]; + float b_test[DATASIZE * DATASIZE * 2]; + float c_test[DATASIZE * DATASIZE * 2]; + float c_verify[DATASIZE * DATASIZE * 2]; + float c_gemm[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CGEMMT data_cgemmt; + +/** + * Compute gemmt via gemm since gemmt is gemm but updates only + * the upper or lower triangular part of the result matrix + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + */ +static void cgemmt_trusted(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, float *alpha, blasint lda, + blasint ldb, float *beta, blasint ldc) +{ + blasint i, j; + + if(api == 'F') + BLASFUNC(cgemm)(&transa, &transb, &m, &m, &k, alpha, data_cgemmt.a_test, &lda, + data_cgemmt.b_test, &ldb, beta, data_cgemmt.c_gemm, &ldc); + else + cblas_cgemm(order, transa, transb, m, m, k, alpha, data_cgemmt.a_test, lda, + data_cgemmt.b_test, ldb, beta, data_cgemmt.c_gemm, ldc); + + ldc *= 2; + + if (uplo == 'L' || uplo == CblasLower) + { + for (i = 0; i < m; i++) + for (j = i * 2; j < m * 2; j+=2){ + data_cgemmt.c_verify[i * ldc + j] = + data_cgemmt.c_gemm[i * ldc + j]; + data_cgemmt.c_verify[i * ldc + j + 1] = + data_cgemmt.c_gemm[i * ldc + j + 1]; + } + } else { + for (i = 0; i < m; i++) + for (j = 0; j <= i * 2; j+=2){ + data_cgemmt.c_verify[i * ldc + j] = + data_cgemmt.c_gemm[i * ldc + j]; + data_cgemmt.c_verify[i * ldc + j + 1] = + data_cgemmt.c_gemm[i * ldc + j + 1]; + } + } +} + +/** + * Comapare results computed by cgemmt and cgemmt_trusted + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static float check_cgemmt(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, float *alpha, blasint lda, + blasint ldb, float *beta, blasint ldc) +{ + blasint i; + blasint b_cols; + blasint a_cols; + blasint inc = 1; + blasint size_c = m * ldc * 2; + + if(order == CblasColMajor){ + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = m; + else a_cols = k; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = k; + else b_cols = m; + } else { + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = k; + else a_cols = m; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = m; + else b_cols = k; + } + + srand_generate(data_cgemmt.a_test, a_cols * lda * 2); + srand_generate(data_cgemmt.b_test, b_cols * ldb * 2); + srand_generate(data_cgemmt.c_test, m * ldc * 2); + + for (i = 0; i < m * ldc * 2; i++) + data_cgemmt.c_gemm[i] = data_cgemmt.c_verify[i] = data_cgemmt.c_test[i]; + + cgemmt_trusted(api, order, uplo, transa, transb, m, k, alpha, lda, ldb, beta, ldc); + + if (api == 'F') + BLASFUNC(cgemmt)(&uplo, &transa, &transb, &m, &k, alpha, data_cgemmt.a_test, + &lda, data_cgemmt.b_test, &ldb, beta, data_cgemmt.c_test, &ldc); + else + cblas_cgemmt(order, uplo, transa, transb, m, k, alpha, data_cgemmt.a_test, lda, + data_cgemmt.b_test, ldb, beta, data_cgemmt.c_test, ldc); + + for (i = 0; i < m * ldc * 2; i++) + data_cgemmt.c_verify[i] -= data_cgemmt.c_test[i]; + + return BLASFUNC(snrm2)(&size_c, data_cgemmt.c_verify, &inc) / size_c; +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in cgemmt + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, blasint lda, blasint ldb, + blasint ldc, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + set_xerbla("CGEMMT ", expected_info); + + if (api == 'F') + BLASFUNC(cgemmt)(&uplo, &transa, &transb, &m, &k, alpha, data_cgemmt.a_test, + &lda, data_cgemmt.b_test, &ldb, beta, data_cgemmt.c_test, &ldc); + else + cblas_cgemmt(order, uplo, transa, transb, m, k, alpha, data_cgemmt.a_test, lda, + data_cgemmt.b_test, ldb, beta, data_cgemmt.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(cgemmt, upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(cgemmt, upper_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(cgemmt, upper_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + char transa = 'N', transb = 'T'; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(cgemmt, upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'U'; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(cgemmt, upper_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + char transa = 'R', transb = 'R'; + char uplo = 'U'; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(cgemmt, upper_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'R'; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(cgemmt, upper_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'R', transb = 'C'; + char uplo = 'U'; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(cgemmt, upper_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'C'; + char uplo = 'U'; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(cgemmt, upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(cgemmt, upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(cgemmt, lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(cgemmt, lower_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'L'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(cgemmt, lower_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + char transa = 'N', transb = 'T'; + char uplo = 'L'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(cgemmt, lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'L'; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(cgemmt, lower_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + char transa = 'R', transb = 'R'; + char uplo = 'L'; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(cgemmt, lower_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'R'; + char uplo = 'L'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(cgemmt, lower_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'R', transb = 'C'; + char uplo = 'L'; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(cgemmt, lower_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'C'; + char uplo = 'L'; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(cgemmt, lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(cgemmt, lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(cgemmt, c_api_colmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(cgemmt, c_api_colmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(cgemmt, c_api_colmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(cgemmt, c_api_colmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 50, ldc = 25; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {-1.0f, -1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 25, ldc = 25; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_25_K_50_a_conjtrans_b_conjtrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(cgemmt, c_api_rowmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(cgemmt, c_api_rowmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 50, ldc = 25; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 25, ldc = 25; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 25, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(cgemmt, c_api_rowmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(cgemmt, c_api_rowmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param uplo. + * Must be upper (U) or lower (L). + */ +CTEST(cgemmt, xerbla_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'O'; + int expected_info = 1; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transa. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(cgemmt, xerbla_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'O', transb = 'N'; + char uplo = 'U'; + int expected_info = 2; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transb. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(cgemmt, xerbla_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'O'; + char uplo = 'U'; + int expected_info = 3; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(cgemmt, xerbla_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 4; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(cgemmt, xerbla_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 5; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(cgemmt, xerbla_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 8; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(cgemmt, xerbla_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 10; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(cgemmt, xerbla_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 13; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. + * Test error function for an invalid param order. + * Must be column or row major. + */ +CTEST(cgemmt, xerbla_c_api_major_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 0; + + int passed = check_badargs('C', 'O', CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasColMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasRowMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B transposed. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_cgemv_n.c b/utest/test_extensions/test_cgemv_n.c new file mode 100644 index 000000000..60c9af86a --- /dev/null +++ b/utest/test_extensions/test_cgemv_n.c @@ -0,0 +1,340 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CSPMV_N { + float a_test[DATASIZE * DATASIZE * 2]; + float b_test[DATASIZE * 2 * INCREMENT]; + float c_test[DATASIZE * 2 * INCREMENT]; + float c_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CSPMV_N data_cgemv_n; + +/** + * cgemv not transposed reference code + * + * param trans specifies whether matris A is conj or/and xconj + * param m - number of rows of A + * param n - number of columns of A + * param alpha - scaling factor for the matrib-vector product + * param a - buffer holding input matrib A + * param lda - leading dimension of matrix A + * param b - Buffer holding input vector b + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param c - buffer holding input/output vector c + * param inc_c - stride of vector c + */ +static void cgemv_n_trusted(char trans, blasint m, blasint n, float *alpha, float *a, + blasint lda, float *b, blasint inc_b, float *beta, float *c, + blasint inc_c) +{ + blasint i, j; + blasint i2 = 0; + blasint ib = 0, ic = 0; + + float temp_r, temp_i; + + float *a_ptr = a; + blasint lda2 = 2*lda; + + blasint inc_b2 = 2 * inc_b; + blasint inc_c2 = 2 * inc_c; + + BLASFUNC(cscal)(&m, beta, c, &inc_c); + + for (j = 0; j < n; j++) + { + + if (trans == 'N' || trans == 'R') { + temp_r = alpha[0] * b[ib] - alpha[1] * b[ib+1]; + temp_i = alpha[0] * b[ib+1] + alpha[1] * b[ib]; + } else { + temp_r = alpha[0] * b[ib] + alpha[1] * b[ib+1]; + temp_i = alpha[0] * b[ib+1] - alpha[1] * b[ib]; + } + + ic = 0; + i2 = 0; + + for (i = 0; i < m; i++) + { + if (trans == 'N') { + c[ic] += temp_r * a_ptr[i2] - temp_i * a_ptr[i2+1]; + c[ic+1] += temp_r * a_ptr[i2+1] + temp_i * a_ptr[i2]; + } + if (trans == 'O') { + c[ic] += temp_r * a_ptr[i2] + temp_i * a_ptr[i2+1]; + c[ic+1] += temp_r * a_ptr[i2+1] - temp_i * a_ptr[i2]; + } + if (trans == 'R') { + c[ic] += temp_r * a_ptr[i2] + temp_i * a_ptr[i2+1]; + c[ic+1] -= temp_r * a_ptr[i2+1] - temp_i * a_ptr[i2]; + } + if (trans == 'S') { + c[ic] += temp_r * a_ptr[i2] - temp_i * a_ptr[i2+1]; + c[ic+1] -= temp_r * a_ptr[i2+1] + temp_i * a_ptr[i2]; + } + i2 += 2; + ic += inc_c2; + } + a_ptr += lda2; + ib += inc_b2; + } + +} + +/** + * Comapare results computed by cgemv and cgemv_n_trusted + * + * param trans specifies whether matris A is conj or/and xconj + * param m - number of rows of A + * param n - number of columns of A + * param alpha - scaling factor for the matrib-vector product + * param lda - leading dimension of matrix A + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param inc_c - stride of vector c + * return norm of differences + */ +static float check_cgemv_n(char trans, blasint m, blasint n, float *alpha, blasint lda, + blasint inc_b, float *beta, blasint inc_c) +{ + blasint i; + + srand_generate(data_cgemv_n.a_test, n * lda); + srand_generate(data_cgemv_n.b_test, 2 * n * inc_b); + srand_generate(data_cgemv_n.c_test, 2 * m * inc_c); + + for (i = 0; i < m * 2 * inc_c; i++) + data_cgemv_n.c_verify[i] = data_cgemv_n.c_test[i]; + + cgemv_n_trusted(trans, m, n, alpha, data_cgemv_n.a_test, lda, data_cgemv_n.b_test, + inc_b, beta, data_cgemv_n.c_test, inc_c); + BLASFUNC(cgemv)(&trans, &m, &n, alpha, data_cgemv_n.a_test, &lda, data_cgemv_n.b_test, + &inc_b, beta, data_cgemv_n.c_verify, &inc_c); + + for (i = 0; i < m * 2 * inc_c; i++) + data_cgemv_n.c_verify[i] -= data_cgemv_n.c_test[i]; + + return BLASFUNC(scnrm2)(&n, data_cgemv_n.c_verify, &inc_c); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cgemv, trans_o_square_matrix) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'O'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.4f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows of A is 50 + * Number of colums of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cgemv, trans_o_rectangular_matrix_rows_less_then_cols) +{ + blasint n = 100, m = 50, lda = 50; + blasint inc_b = 1, inc_c = 1; + char trans = 'O'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.4f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows of A is 100 + * Number of colums of A is 50 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cgemv, trans_o_rectangular_matrix_cols_less_then_rows) +{ + blasint n = 50, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'O'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.4f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(cgemv, trans_o_double_strides) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 2, inc_c = 2; + char trans = 'O'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.4f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cgemv, trans_s_square_matrix) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'S'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.4f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows of A is 50 + * Number of colums of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cgemv, trans_s_rectangular_matrix_rows_less_then_cols) +{ + blasint n = 100, m = 50, lda = 50; + blasint inc_b = 1, inc_c = 1; + char trans = 'S'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.4f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows of A is 100 + * Number of colums of A is 50 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cgemv, trans_s_rectangular_matrix_cols_less_then_rows) +{ + blasint n = 50, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'S'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.4f, 0.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(cgemv, trans_s_double_strides) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 2, inc_c = 2; + char trans = 'S'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.0f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +#endif diff --git a/utest/test_extensions/test_cgemv_t.c b/utest/test_extensions/test_cgemv_t.c new file mode 100644 index 000000000..aa3281e66 --- /dev/null +++ b/utest/test_extensions/test_cgemv_t.c @@ -0,0 +1,1132 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define N 100 +#define M 100 +#define INCREMENT 2 + +struct DATA_CGEMV_T { + float a_test[N * M * 2]; + float a_verify[N * M * 2]; + float y_test[M * INCREMENT * 2]; + float y_verify[M * INCREMENT * 2]; + float x_test[M * INCREMENT * 2]; + float x_verify[M * INCREMENT * 2]; +}; + +// SINGLE_EPS_ZGEMV = MAX_VAL * NUMBER OF OPERATIONS * FLT_EPSILON +// SINGLE_EPS_ZGEMV = 5.0 * O(100 * 100) * 1.19e-07 = 5*e-03 +#define SINGLE_EPS_ZGEMV 5e-03 + +#ifdef BUILD_COMPLEX +static struct DATA_CGEMV_T data_cgemv_t; + +/** + * Find product of matrix-vector multiplication + * + * param n specifies number of columns of A + * param m specifies number of rows of A and size of vector x + * param lda specifies leading dimension of A + * param inc_x specifies increment of vector x + */ +static void matrix_vector_product(blasint n, blasint m, blasint lda, blasint inc_x) +{ + blasint i; + float *a_ptr = data_cgemv_t.a_verify; + float *x_ptr = data_cgemv_t.x_test; + float *x_res = data_cgemv_t.x_verify; + + openblas_complex_float result; + + for (i = 0; i < n * inc_x; i+= inc_x) + { + result = cblas_cdotu(lda, a_ptr, 1, x_ptr, inc_x); + x_res[0] = CREAL(result); + x_res[1] = CIMAG(result); + a_ptr += lda * 2; + x_res += 2 * inc_x; + } +} + +/** + * Test cgemv by comparing it against comatcopy, caxpby and + * reference func matrix_vector_product + * + * comatcopy perform operation: op(A) + * matrix_vector_product perform operation: A*x + * caxpby perform operation: alpha*x + beta*y + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param m specifies number of rows of A + * param n specifies number of columns of A + * param alpha specifies scalar alpha + * param lda specifies leading dimension of the matrix A + * param inc_x specifies increment for vector x + * param beta specifies scalar beta + * param inc_y specifies increment for vector y + * return norm of difference between cgemv and result of reference funcs + */ +static float check_cgemv(char api, char order, char trans, blasint m, blasint n, float *alpha, + blasint lda, blasint inc_x, float *beta, blasint inc_y) +{ + blasint i; + + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + + // Transpose parameters for comatcopy + // cgemv_t perform operation on transposed matrix, no need to transpose a_verify + char trans_copy; + char ctrans_copy; + + // Param alpha for comatcopy, scale on alpha perform caxpby + float alpha_one[] = {1.0f, 0.0f}; + + memset(data_cgemv_t.x_verify, 0.0f, m * inc_x * 2 * sizeof(float)); + + // Fill matrix A, vectors x, y + srand_generate(data_cgemv_t.a_test, lda * n * 2); + srand_generate(data_cgemv_t.x_test, m * inc_x * 2); + srand_generate(data_cgemv_t.y_test, m * inc_y * 2); + + // Copy vector y for reference funcs + for (int i = 0; i < m * inc_y * 2; i++) { + data_cgemv_t.y_verify[i] = data_cgemv_t.y_test[i]; + } + + if (api == 'F') { + if (trans == 'T') trans_copy = 'N'; + if (trans == 'C') trans_copy = 'R'; + if (trans == 'U') trans_copy = 'R'; + if (trans == 'D') trans_copy = 'N'; + + // Perform operation: op(A) + BLASFUNC(comatcopy)(&order, &trans_copy, &m, &n, alpha_one, data_cgemv_t.a_test, &lda, data_cgemv_t.a_verify, &lda); + + // Find A*x + matrix_vector_product(n, m, lda, inc_x); + + // Find conj(x) + if (trans == 'U' || trans == 'D') { + cconjugate_vector(m, inc_x, data_cgemv_t.x_verify); + } + + // Find alpha*x+beta*y + BLASFUNC(caxpby)(&n, alpha, data_cgemv_t.x_verify, &inc_x, beta, data_cgemv_t.y_verify, &inc_y); + + BLASFUNC(cgemv)(&trans, &m, &n, alpha, data_cgemv_t.a_test, + &lda, data_cgemv_t.x_test, &inc_x, beta, data_cgemv_t.y_test, &inc_y); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') {ctrans = CblasTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasTrans : CblasNoTrans;} + if (trans == 'N') {ctrans = CblasNoTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasNoTrans : CblasTrans;} + if (trans == 'C') {ctrans = CblasConjTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasConjTrans : CblasConjNoTrans;} + if (trans == 'R') {ctrans = CblasConjNoTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasConjNoTrans : CblasConjTrans;} + + // Perform operation: op(A) + cblas_comatcopy(corder, ctrans_copy, m, n, alpha_one, data_cgemv_t.a_test, lda, data_cgemv_t.a_verify, lda); + + // Find A*x + matrix_vector_product(n, m, lda, inc_x); + + // Find alpha*x+beta*y + cblas_caxpby(n, alpha, data_cgemv_t.x_verify, inc_x, beta, data_cgemv_t.y_verify, inc_y); + + cblas_cgemv(corder, ctrans, m, n, alpha, data_cgemv_t.a_test, + lda, data_cgemv_t.x_test, inc_x, beta, data_cgemv_t.y_test, inc_y); + } + + // Find the differences between output vector caculated by cgemv and reference funcs + for (i = 0; i < m * inc_y * 2; i++) + data_cgemv_t.y_test[i] -= data_cgemv_t.y_verify[i]; + + // Find the norm of differences + return cblas_scnrm2(m, data_cgemv_t.y_test, inc_y); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param m specifies number of rows of A + * param n specifies number of columns of A + * param lda specifies leading dimension of the matrix A + * param inc_x specifies increment for vector x + * param inc_y specifies increment for vector y + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint m, blasint n, + blasint lda, blasint inc_x, blasint inc_y, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + float a[] = {1.0f, 1.0f}; + float x[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + float y[] = {1.0f, 1.0f}; + + set_xerbla("CGEMV ", expected_info); + + BLASFUNC(cgemv)(&trans, &m, &n, alpha, a, &lda, x, &inc_x, beta, y, &inc_y); + + return check_error(); +} + +/** + * C API specific function + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param m specifies number of rows of A + * param n specifies number of columns of A + * param lda specifies leading dimension of the matrix A + * param inc_x specifies increment for vector x + * param inc_y specifies increment for vector y + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int c_api_check_badargs(CBLAS_ORDER corder, CBLAS_TRANSPOSE ctrans, blasint m, blasint n, + blasint lda, blasint inc_x, blasint inc_y, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + float a[] = {1.0f, 1.0f}; + float x[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + float y[] = {1.0f, 1.0f}; + + set_xerbla("CGEMV ", expected_info); + + cblas_cgemv(corder, ctrans, m, n, alpha, a, lda, x, inc_x, beta, y, inc_y); + + return check_error(); +} + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0f, alpha_i = 1.0f + * beta_r = 2.0f, beta_i = 2.0f + */ +CTEST(cgemv, colmajor_trans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'T'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 2.0f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0f, alpha_i = 1.0f + * beta_r = 2.0f, beta_i = 2.0f + */ +CTEST(cgemv, colmajor_trans_col_100_row_100_inc_x_2_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'T'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 2.0f}; + + blasint inc_x = 2; + blasint inc_y = 1; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 2.0f, alpha_i = 1.0f + * beta_r = 2.0f, beta_i = 1.0f + */ +CTEST(cgemv, colmajor_conjtrans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 1, inc y = 2 + * alpha_r = 2.0f, alpha_i = 1.0f + * beta_r = 2.0f, beta_i = 1.0f + */ +CTEST(cgemv, colmajor_conjtrans_col_100_row_100_inc_x_1_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + blasint inc_x = 1; + blasint inc_y = 2; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and x conjugate + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 2.0f, alpha_i = 1.0f + * beta_r = 2.0f, beta_i = 1.0f + */ +CTEST(cgemv, colmajor_trans_x_conj_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'U'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and x conjugate + * Square matrix + * inc x = 2, inc y = 2 + * alpha_r = 1.0f, alpha_i = 2.0f + * beta_r = 1.0f, beta_i = 1.0f + */ +CTEST(cgemv, colmajor_trans_x_conj_col_100_row_100_inc_x_2_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'U'; + + float alpha[] = {1.0f, 2.0f}; + float beta[] = {1.0f, 1.0f}; + + blasint inc_x = 2; + blasint inc_y = 2; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition, conjugate A, conjugate x + * Square matrix + * inc x = 2, inc y = 2 + * alpha_r = 2.0f, alpha_i = 1.0f + * beta_r = 1.0f, beta_i = 2.0f + */ +CTEST(cgemv, colmajor_conjtrans_x_conj_col_100_row_100_inc_x_1_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'D'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 2.0f}; + + blasint inc_x = 1; + blasint inc_y = 2; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition, conjugate A, conjugate x + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 2.0f, alpha_i = 1.0f + * beta_r = 1.0f, beta_i = 2.0f + */ +CTEST(cgemv, c_api_colmajor_trans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'T'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 2.0f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0f, alpha_i = 1.0f + * beta_r = 1.0f, beta_i = 2.0f + */ +CTEST(cgemv, c_api_colmajor_conjtrans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 2.0f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 1, inc y = 2 + * alpha_r = 1.0f, alpha_i = 1.0f + * beta_r = 1.0f, beta_i = 2.0f + */ +CTEST(cgemv, c_api_colmajor_conjtrans_col_100_row_100_inc_x_1_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 2.0f}; + + blasint inc_x = 1; + blasint inc_y = 2; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Row Major + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 2.0f, alpha_i = 1.0f + * beta_r = 1.0f, beta_i = 1.0f + */ +CTEST(cgemv, c_api_rowmajor_notrans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'N'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Row Major + * No trans + * Square matrix + * inc x = 2, inc y = 2 + * alpha_r = 1.0f, alpha_i = 1.0f + * beta_r = 3.0f, beta_i = 2.0f + */ +CTEST(cgemv, c_api_rowmajor_notrans_col_100_row_100_inc_x_2_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'N'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {3.0f, 1.0f}; + + blasint inc_x = 2; + blasint inc_y = 2; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Conjugate + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 1.0f, alpha_i = 3.0f + * beta_r = 1.0f, beta_i = 2.5f + */ +CTEST(cgemv, c_api_rowmajor_conj_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'R'; + + float alpha[] = {1.0f, 3.0f}; + float beta[] = {1.0f, 2.5f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Row Major + * Conjugate + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0f, alpha_i = 1.0f + * beta_r = 1.0f, beta_i = 1.5f + */ +CTEST(cgemv, c_api_rowmajor_conj_col_100_row_100_inc_x_2_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'R'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.5f}; + + blasint inc_x = 2; + blasint inc_y = 1; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test error function for an invalid param inc_y. + * Must be positive + * + * Column major + */ +CTEST(cgemv, xerbla_invalid_inc_y) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 0; + + int expected_info = 11; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_y. + * Must be positive + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_inc_y_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 0; + + int expected_info = 11; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_y. + * Must be positive + * + * Row major + */ +CTEST(cgemv, c_api_xerbla_invalid_inc_y_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 0; + + int expected_info = 11; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param inc_x. + * Must be positive + * + * Column major + */ +CTEST(cgemv, xerbla_invalid_inc_x) +{ + char order = 'C'; + char trans = 'T'; + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 0; + blasint inc_y = 1; + + int expected_info = 8; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_x. + * Must be positive + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_inc_x_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 0; + blasint inc_y = 1; + + int expected_info = 8; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_x. + * Must be positive + * + * Row major + */ +CTEST(cgemv, c_api_xerbla_invalid_inc_x_row_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 0; + blasint inc_y = 1; + + int expected_info = 8; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param n. + * Must be positive. + * + * Column major + */ +CTEST(cgemv, xerbla_invalid_n) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = 1, n = INVALID; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n. + * Must be positive. + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_n_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = INVALID; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 3; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n. + * Must be positive. + * + * Row major + */ +CTEST(cgemv, c_api_xerbla_invalid_n_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = INVALID, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 3; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param m. + * Must be positive. + * + * Column major + */ +CTEST(cgemv, xerbla_invalid_m) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = INVALID, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m. + * Must be positive. + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_m_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = INVALID, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 2; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m. + * Must be positive. + * + * Row major + */ +CTEST(cgemv, c_api_xerbla_invalid_m_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = 1, n = INVALID; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 2; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda. + * lda must be at least n. + * + * Column major + */ +CTEST(cgemv, xerbla_invalid_lda) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = 1, n = 1; + blasint lda = INVALID; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 6; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda. + * If matrices are stored using col major layout, + * lda must be at least m. + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_lda_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = INVALID; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 6; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda. + * If matrices are stored using col major layout, + * lda must be at least n. + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_lda_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = 1, n = 1; + blasint lda = INVALID; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 6; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param trans. + * + * Column major + */ +CTEST(cgemv, xerbla_invalid_trans) +{ + char order = 'C'; + char trans = 'Z'; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param trans. + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_trans_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = INVALID; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 1; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param trans. + * + * Row major + */ +CTEST(cgemv, c_api_xerbla_invalid_trans_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = INVALID; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 1; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param order. + */ +CTEST(cgemv, c_api_xerbla_invalid_order_col_major) +{ + enum CBLAS_ORDER corder = INVALID; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 0; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_cimatcopy.c b/utest/test_extensions/test_cimatcopy.c new file mode 100644 index 000000000..800f8a2d1 --- /dev/null +++ b/utest/test_extensions/test_cimatcopy.c @@ -0,0 +1,850 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_CIMATCOPY { + float a_test[DATASIZE * DATASIZE * 2]; + float a_verify[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CIMATCOPY data_cimatcopy; + +/** + * Comapare results computed by cimatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param alpha specifies scaling factor for matrix A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * return norm of difference between openblas and reference func + */ +static float check_cimatcopy(char api, char order, char trans, blasint rows, blasint cols, float *alpha, + blasint lda_src, blasint lda_dst) +{ + blasint m, n; + blasint rows_out, cols_out; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + int conj = -1; + + if (order == 'C') { + n = rows; m = cols; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + rows_out = n; cols_out = m*2; + if (trans == 'C') + conj = 1; + } + else { + rows_out = m; cols_out = n*2; + if (trans == 'R') + conj = 1; + } + + srand_generate(data_cimatcopy.a_test, lda_src*m*2); + + if (trans == 'T' || trans == 'C') { + ctranspose(m, n, alpha, data_cimatcopy.a_test, lda_src, data_cimatcopy.a_verify, lda_dst, conj); + } + else { + ccopy(m, n, alpha, data_cimatcopy.a_test, lda_src, data_cimatcopy.a_verify, lda_dst, conj); + } + + if (api == 'F') { + BLASFUNC(cimatcopy)(&order, &trans, &rows, &cols, alpha, data_cimatcopy.a_test, + &lda_src, &lda_dst); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_cimatcopy(corder, ctrans, rows, cols, alpha, data_cimatcopy.a_test, + lda_src, lda_dst); + } + + // Find the differences between output matrix computed by cimatcopy and reference func + return smatrix_difference(data_cimatcopy.a_test, data_cimatcopy.a_verify, cols_out, rows_out, 2*lda_dst); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda_src, blasint lda_dst, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + + set_xerbla("CIMATCOPY", expected_info); + + BLASFUNC(cimatcopy)(&order, &trans, &rows, &cols, alpha, data_cimatcopy.a_test, + &lda_src, &lda_dst); + + return check_error(); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha_r = -3.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha[] = {-3.0f, 1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'R'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, colmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'C'; + float alpha[] = {2.0f, 1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, colmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 50; + char order = 'C'; + char trans = 'N'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific tests + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, colmajor_conjtrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'C'; + float alpha[] = {1.0f, 1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, colmajor_conj_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 50; + char order = 'C'; + char trans = 'R'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha_r = 2.0, alpha_i = 3.0 + */ +CTEST(cimatcopy, rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha[] = {2.0f, 3.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific tests + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'R'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific tests + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'C'; + float alpha[] = {2.0f, 1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 50; + char order = 'R'; + char trans = 'N'; + float alpha[] = {2.0f, 1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, rowmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(cimatcopy, rowmajor_conj_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 50; + char order = 'R'; + char trans = 'R'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, rowmajor_conjtrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'C'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha_r = 3.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, c_api_colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + float alpha[] = {3.0f, 2.0f}; + + float norm = check_cimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha_r = 3.0, alpha_i = 1.5 + */ +CTEST(cimatcopy, c_api_colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha[] = {3.0f, 1.5f}; + + float norm = check_cimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha_r = 3.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, c_api_rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha[] = {3.0f, 1.0f}; + + float norm = check_cimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, c_api_colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'R'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, c_api_colmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'C'; + float alpha[] = {2.0f, 1.0f}; + + float norm = check_cimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha_r = 1.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, c_api_rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha[] = {1.0f, 1.0f}; + + float norm = check_cimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(cimatcopy, c_api_rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'R'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, c_api_rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'C'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(cimatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(cimatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(cimatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda_src = 0, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(cimatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda_src = 100, lda_dst = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using row major layout, + * lda_src must be at least n. + */ +CTEST(cimatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using column major layout, + * lda_src must be at least m. + */ +CTEST(cimatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is no transposition, lda_dst must be at least n. + */ +CTEST(cimatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is transposition, lda_dst must be at least m. + */ +CTEST(cimatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is no transposition, lda_dst must be at least m. + */ +CTEST(cimatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is transposition, lda_dst must be at least n. + */ +CTEST(cimatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_comatcopy.c b/utest/test_extensions/test_comatcopy.c new file mode 100644 index 000000000..8a3d5ee7b --- /dev/null +++ b/utest/test_extensions/test_comatcopy.c @@ -0,0 +1,728 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_COMATCOPY { + float a_test[DATASIZE * DATASIZE * 2]; + float b_test[DATASIZE * DATASIZE * 2]; + float b_verify[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_COMATCOPY data_comatcopy; + +/** + * Comapare results computed by comatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param alpha - scaling factor for matrix B + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * return norm of difference between openblas and reference func + */ +static float check_comatcopy(char api, char order, char trans, blasint rows, blasint cols, float* alpha, + blasint lda, blasint ldb) +{ + blasint b_rows, b_cols; + blasint m, n; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + int conj = -1; + + if (order == 'C') { + m = cols; n = rows; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + b_rows = n; b_cols = m*2; + if (trans == 'C') + conj = 1; + } + else { + b_rows = m; b_cols = n*2; + if (trans == 'R') + conj = 1; + } + + srand_generate(data_comatcopy.a_test, lda*m*2); + + if (trans == 'T' || trans == 'C') { + ctranspose(m, n, alpha, data_comatcopy.a_test, lda, data_comatcopy.b_verify, ldb, conj); + } + else { + ccopy(m, n, alpha, data_comatcopy.a_test, lda, data_comatcopy.b_verify, ldb, conj); + } + + if (api == 'F') { + BLASFUNC(comatcopy)(&order, &trans, &rows, &cols, alpha, data_comatcopy.a_test, + &lda, data_comatcopy.b_test, &ldb); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_comatcopy(corder, ctrans, rows, cols, alpha, data_comatcopy.a_test, + lda, data_comatcopy.b_test, ldb); + } + + return smatrix_difference(data_comatcopy.b_test, data_comatcopy.b_verify, b_cols, b_rows, ldb*2); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda, blasint ldb, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + + set_xerbla("COMATCOPY", expected_info); + + BLASFUNC(comatcopy)(&order, &trans, &rows, &cols, alpha, data_comatcopy.a_test, + &lda, data_comatcopy.b_test, &ldb); + + return check_error(); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * alpha_r = -1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + float alpha[] = {-1.0f, 2.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'R'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(comatcopy, colmajor_conjtrnas_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'C'; + float alpha[] = {2.0f, 1.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(comatcopy, rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 50; + char order = 'R'; + char trans = 'N'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(comatcopy, rowmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(comatcopy, rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'R'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'C'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, c_api_colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * alpha_r = -1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, c_api_colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + float alpha[] = {-1.0f, 2.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, c_api_colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'R'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(comatcopy, c_api_colmajor_conjtrnas_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'C'; + float alpha[] = {2.0f, 1.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(comatcopy, c_api_rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 50; + char order = 'R'; + char trans = 'N'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(comatcopy, c_api_rowmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(comatcopy, c_api_rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'R'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, c_api_rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'C'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(comatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(comatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(comatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda = 0, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(comatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda = 100, ldb = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda. + * If matrices are stored using row major layout, + * lda must be at least n. + */ +CTEST(comatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda. + * If matrices are stored using column major layout, + * lda must be at least m. + */ +CTEST(comatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is no transposition, ldb must be at least n. + */ +CTEST(comatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is transposition, ldb must be at least m. + */ +CTEST(comatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is no transposition, ldb must be at least n. + */ +CTEST(comatcopy, xerbla_rowmajor_conj_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'R'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is transposition, ldb must be at least m. + */ +CTEST(comatcopy, xerbla_rowmajor_transconj_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'C'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is no transposition, ldb must be at least m. + */ +CTEST(comatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is transposition, ldb must be at least n. + */ +CTEST(comatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is no transposition, ldb must be at least m. + */ +CTEST(comatcopy, xerbla_colmajor_conj_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'R'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is transposition, ldb must be at least n. + */ +CTEST(comatcopy, xerbla_colmajor_transconj_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'C'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif diff --git a/utest/test_extensions/test_crot.c b/utest/test_extensions/test_crot.c new file mode 100644 index 000000000..1c55216d9 --- /dev/null +++ b/utest/test_extensions/test_crot.c @@ -0,0 +1,792 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CROT { + float x_test[DATASIZE * INCREMENT * 2]; + float y_test[DATASIZE * INCREMENT * 2]; + float x_verify[DATASIZE * INCREMENT * 2]; + float y_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CROT data_crot; + +/** + * Fortran API specific function + * Comapare results computed by csrot and caxpby + * + * param n specifies size of vector x + * param inc_x specifies increment of vector x + * param inc_y specifies increment of vector y + * param c specifies cosine + * param s specifies sine + * return norm of differences + */ +static float check_csrot(blasint n, blasint inc_x, blasint inc_y, float *c, float *s) +{ + blasint i; + float norm = 0; + float s_neg[] = {-s[0], s[1]}; + + blasint inc_x_abs = labs(inc_x); + blasint inc_y_abs = labs(inc_y); + + // Fill vectors x, y + srand_generate(data_crot.x_test, n * inc_x_abs * 2); + srand_generate(data_crot.y_test, n * inc_y_abs * 2); + + if (inc_x == 0 && inc_y == 0) { + srand_generate(data_crot.x_test, n * 2); + srand_generate(data_crot.y_test, n * 2); + } + + // Copy vector x for caxpby + for (i = 0; i < n * inc_x_abs * 2; i++) + data_crot.x_verify[i] = data_crot.x_test[i]; + + // Copy vector y for caxpby + for (i = 0; i < n * inc_y_abs * 2; i++) + data_crot.y_verify[i] = data_crot.y_test[i]; + + // Find cx = c*x + s*y + BLASFUNC(caxpby)(&n, s, data_crot.y_test, &inc_y, c, data_crot.x_verify, &inc_x); + + // Find cy = -conjg(s)*x + c*y + BLASFUNC(caxpby)(&n, s_neg, data_crot.x_test, &inc_x, c, data_crot.y_verify, &inc_y); + + BLASFUNC(csrot)(&n, data_crot.x_test, &inc_x, data_crot.y_test, &inc_y, c, s); + + // Find the differences between vector x caculated by caxpby and csrot + for (i = 0; i < n * 2 * inc_x_abs; i++) + data_crot.x_test[i] -= data_crot.x_verify[i]; + + // Find the differences between vector y caculated by caxpby and csrot + for (i = 0; i < n * 2 * inc_y_abs; i++) + data_crot.y_test[i] -= data_crot.y_verify[i]; + + // Find the norm of differences + norm += BLASFUNC(scnrm2)(&n, data_crot.x_test, &inc_x_abs); + norm += BLASFUNC(scnrm2)(&n, data_crot.y_test, &inc_y_abs); + return (norm / 2); +} + +/** + * C API specific function + * Comapare results computed by csrot and caxpby + * + * param n specifies size of vector x + * param inc_x specifies increment of vector x + * param inc_y specifies increment of vector y + * param c specifies cosine + * param s specifies sine + * return norm of differences + */ +static float c_api_check_csrot(blasint n, blasint inc_x, blasint inc_y, float *c, float *s) +{ + blasint i; + float norm = 0; + float s_neg[] = {-s[0], s[1]}; + + blasint inc_x_abs = labs(inc_x); + blasint inc_y_abs = labs(inc_y); + + // Fill vectors x, y + srand_generate(data_crot.x_test, n * inc_x_abs * 2); + srand_generate(data_crot.y_test, n * inc_y_abs * 2); + + if (inc_x == 0 && inc_y == 0) { + srand_generate(data_crot.x_test, n * 2); + srand_generate(data_crot.y_test, n * 2); + } + + // Copy vector x for caxpby + for (i = 0; i < n * inc_x_abs * 2; i++) + data_crot.x_verify[i] = data_crot.x_test[i]; + + // Copy vector y for caxpby + for (i = 0; i < n * inc_y_abs * 2; i++) + data_crot.y_verify[i] = data_crot.y_test[i]; + + // Find cx = c*x + s*y + cblas_caxpby(n, s, data_crot.y_test, inc_y, c, data_crot.x_verify, inc_x); + + // Find cy = -conjg(s)*x + c*y + cblas_caxpby(n, s_neg, data_crot.x_test, inc_x, c, data_crot.y_verify, inc_y); + + cblas_csrot(n, data_crot.x_test, inc_x, data_crot.y_test, inc_y, c[0], s[0]); + + // Find the differences between vector x caculated by caxpby and csrot + for (i = 0; i < n * 2 * inc_x_abs; i++) + data_crot.x_test[i] -= data_crot.x_verify[i]; + + // Find the differences between vector y caculated by caxpby and csrot + for (i = 0; i < n * 2 * inc_y_abs; i++) + data_crot.y_test[i] -= data_crot.y_verify[i]; + + // Find the norm of differences + norm += cblas_scnrm2(n, data_crot.x_test, inc_x_abs); + norm += cblas_scnrm2(n, data_crot.y_test, inc_y_abs); + return (norm / 2); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 0 + * Stride of vector y is 0 + * c = 1.0f + * s = 2.0f + */ +CTEST(crot, inc_x_0_inc_y_0) +{ + blasint n = 100; + + blasint inc_x = 0; + blasint inc_y = 0; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {2.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, inc_x_1_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is -1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, inc_x_neg_1_inc_y_neg_1) +{ + blasint n = 100; + + blasint inc_x = -1; + blasint inc_y = -1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * c = 3.0f + * s = 2.0f + */ +CTEST(crot, inc_x_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {3.0f, 0.0f}; + float s[] = {2.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is 1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, inc_x_neg_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, inc_x_1_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is -2 + * c = 2.0f + * s = 1.0f + */ +CTEST(crot, inc_x_1_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = -2; + + // Imaginary part for caxpby + float c[] = {2.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0f + * s = 2.0f + */ +CTEST(crot, inc_x_2_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {2.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, inc_x_neg_2_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = -2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 0.0f + * s = 1.0f + */ +CTEST(crot, inc_x_2_inc_y_2_c_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {0.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0f + * s = 0.0f + */ +CTEST(crot, inc_x_2_inc_y_2_s_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {0.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 0 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, check_n_zero) +{ + blasint n = 0; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 0 + * Stride of vector y is 0 + * c = 1.0f + * s = 2.0f + */ +CTEST(crot, c_api_inc_x_0_inc_y_0) +{ + blasint n = 100; + + blasint inc_x = 0; + blasint inc_y = 0; + + // Imaginary part for caxpby + float c[] = {3.0f, 0.0f}; + float s[] = {2.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_1_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is -1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_neg_1_inc_y_neg_1) +{ + blasint n = 100; + + blasint inc_x = -1; + blasint inc_y = -1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * c = 3.0f + * s = 2.0f + */ +CTEST(crot, c_api_inc_x_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {3.0f, 0.0f}; + float s[] = {2.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is 1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_neg_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_1_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is -2 + * c = 2.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_1_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = -2; + + // Imaginary part for caxpby + float c[] = {2.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0f + * s = 2.0f + */ +CTEST(crot, c_api_inc_x_2_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {2.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_neg_2_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = -2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 0.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_2_inc_y_2_c_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {0.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0f + * s = 0.0f + */ +CTEST(crot, c_api_inc_x_2_inc_y_2_s_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {0.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 0 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, c_api_check_n_zero) +{ + blasint n = 0; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_crotg.c b/utest/test_extensions/test_crotg.c new file mode 100644 index 000000000..9db7dc7d3 --- /dev/null +++ b/utest/test_extensions/test_crotg.c @@ -0,0 +1,290 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#ifdef BUILD_COMPLEX + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, zero_a) +{ + float sa[2] = {0.0f, 0.0f}; + float sb[2] = {1.0f, 1.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.0f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[1], SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, zero_b) +{ + float sa[2] = {1.0f, 1.0f}; + float sb[2] = {0.0f, 0.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(1.0f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[1], SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, zero_real) +{ + float sa[2] = {0.0f, 1.0f}; + float sb[2] = {0.0f, 1.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.7071f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.7071f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421f, sa[1], SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, positive_real_positive_img) +{ + float sa[2] = {3.0f, 4.0f}; + float sb[2] = {4.0f, 6.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997f, sa[1], SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, negative_real_positive_img) +{ + float sa[2] = {-3.0f, 4.0f}; + float sb[2] = {-4.0f, 6.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997f, sa[1], SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, positive_real_negative_img) +{ + float sa[2] = {3.0f, -4.0f}; + float sb[2] = {4.0f, -6.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997f, sa[1], SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, negative_real_negative_img) +{ + float sa[2] = {-3.0f, -4.0f}; + float sb[2] = {-4.0f, -6.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_zero_a) +{ + float sa[2] = {0.0f, 0.0f}; + float sb[2] = {1.0f, 1.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.0f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_zero_b) +{ + float sa[2] = {1.0f, 1.0f}; + float sb[2] = {0.0f, 0.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(1.0f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_zero_real) +{ + float sa[2] = {0.0f, 1.0f}; + float sb[2] = {0.0f, 1.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.7071f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.7071f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_positive_real_positive_img) +{ + float sa[2] = {3.0f, 4.0f}; + float sb[2] = {4.0f, 6.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_negative_real_positive_img) +{ + float sa[2] = {-3.0f, 4.0f}; + float sb[2] = {-4.0f, 6.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_positive_real_negative_img) +{ + float sa[2] = {3.0f, -4.0f}; + float sb[2] = {4.0f, -6.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_negative_real_negative_img) +{ + float sa[2] = {-3.0f, -4.0f}; + float sb[2] = {-4.0f, -6.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997f, sa[1], SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_csbmv.c b/utest/test_extensions/test_csbmv.c new file mode 100644 index 000000000..8e8ce4530 --- /dev/null +++ b/utest/test_extensions/test_csbmv.c @@ -0,0 +1,606 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CSBMV { + float sp_matrix[DATASIZE * (DATASIZE + 1)]; + float sb_matrix[DATASIZE * DATASIZE * 2]; + float b_test[DATASIZE * 2 * INCREMENT]; + float c_test[DATASIZE * 2 * INCREMENT]; + float c_verify[DATASIZE * 2 * INCREMENT]; +}; + +// SINGLE_EPS_ZGEMV = MAX_VAL * NUMBER OF OPERATIONS * FLT_EPSILON +// SINGLE_EPS_ZGEMV = 5.0 * O(100 * 100) * 1.19e-07 = 5*e-03 +#define SINGLE_EPS_ZGEMV 5e-03 + +#ifdef BUILD_COMPLEX +static struct DATA_CSBMV data_csbmv; + +/** + * Transform full-storage symmetric band matrix A to upper (U) or lower (L) + * band-packed storage mode. + * + * param uplo specifies whether matrix a is upper or lower band-packed. + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + * output param a - buffer for holding symmetric band-packed matrix + * param lda - specifies the leading dimension of a + * param sb_matrix - buffer holding full-storage symmetric band matrix A + * param ldm - specifies the leading dimension of A + */ +static void transform_to_band_storage(char uplo, blasint n, blasint k, float* a, blasint lda, + float* sb_matrix, blasint ldm) +{ + blasint i, j, m; + if (uplo == 'L') { + for (j = 0; j < n; j++) + { + m = -j; + for (i = 2 * j; i < MIN(2 * n, 2 * (j + k + 1)); i += 2) + { + a[(2*m + i) + j * lda * 2] = sb_matrix[i + j * ldm * 2]; + a[(2*m + (i + 1)) + j * lda * 2] = sb_matrix[(i + 1) + j * ldm * 2]; + } + } + } + else { + for (j = 0; j < n; j++) + { + m = k - j; + for (i = MAX(0, 2*(j - k)); i <= j*2; i += 2) + { + a[(2*m + i) + j * lda * 2] = sb_matrix[i + j * ldm * 2]; + a[(2*m + (i + 1)) + j * lda * 2] = sb_matrix[(i + 1) + j * ldm * 2]; + } + } + } +} + +/** + * Generate full-storage symmetric band matrix A with k - super-diagonals + * from input symmetric packed matrix in lower packed mode (L) + * + * output param sb_matrix - buffer for holding full-storage symmetric band matrix. + * param sp_matrix - buffer holding input symmetric packed matrix + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + */ +static void get_symmetric_band_matr(float *sb_matrix, float *sp_matrix, blasint n, blasint k) +{ + blasint m; + blasint i, j; + m = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < n * 2; j += 2) + { + // Make matrix band with k super-diagonals + if (fabs((i+1) - ceil((j+1)/2.0f)) > k) + { + sb_matrix[i * n * 2 + j] = 0.0f; + sb_matrix[i * n * 2 + j + 1] = 0.0f; + continue; + } + + if (j / 2 < i) + { + sb_matrix[i * n * 2 + j] = + sb_matrix[j * n + i * 2]; + sb_matrix[i * n * 2 + j + 1] = + sb_matrix[j * n + i * 2 + 1]; + } + else + { + sb_matrix[i * n * 2 + j] = sp_matrix[m++]; + sb_matrix[i * n * 2 + j + 1] = sp_matrix[m++]; + } + } + } +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether matrix a is upper or lower band-packed. + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + * param lda - specifies the leading dimension of a + * param inc_b - stride of vector b_test + * param inc_c - stride of vector c_test + * param expected_info - expected invalid parameter number in csbmv + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char uplo, blasint n, blasint k, blasint lda, blasint inc_b, + blasint inc_c, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float a[2]; + srand_generate(a, 2); + + set_xerbla("CSBMV ", expected_info); + + BLASFUNC(csbmv)(&uplo, &n, &k, alpha, a, &lda, data_csbmv.b_test, + &inc_b, beta, data_csbmv.c_test, &inc_c); + + return check_error(); +} + +/** + * Comapare results computed by csbmv and cgemv + * since csbmv is cgemv for symmetric band matrix + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + * param alpha - scaling factor for the matrix-vector product + * param lda - specifies the leading dimension of a + * param inc_b - stride of vector b_test + * param beta - scaling factor for vector c_test + * param inc_c - stride of vector c_test + * param lda - specifies the leading dimension of a + * return norm of differences + */ +static float check_csbmv(char uplo, blasint n, blasint k, float *alpha, blasint lda, + blasint inc_b, float *beta, blasint inc_c, blasint ldm) +{ + blasint i; + + // Trans param for gemv (can use any, since the input matrix is symmetric) + char trans = 'N'; + + // Symmetric band packed matrix for sbmv + float a[lda * n * 2]; + + // Fill symmetric packed matrix sp_matrix, vector b_test, vector c_test + srand_generate(data_csbmv.sp_matrix, n * (n + 1)); + srand_generate(data_csbmv.b_test, n * inc_b * 2); + srand_generate(data_csbmv.c_test, n * inc_c * 2); + + // Copy vector c_test for cgemv + for (i = 0; i < n * inc_c * 2; i++) + data_csbmv.c_verify[i] = data_csbmv.c_test[i]; + + // Generate full-storage symmetric band matrix + // with k super-diagonals from symmetric packed matrix + get_symmetric_band_matr(data_csbmv.sb_matrix, data_csbmv.sp_matrix, n, k); + + // Transform symmetric band matrix from conventional + // full matrix storage to band storage for csbmv + transform_to_band_storage(uplo, n, k, a, lda, data_csbmv.sb_matrix, ldm); + + BLASFUNC(cgemv)(&trans, &n, &n, alpha, data_csbmv.sb_matrix, &ldm, data_csbmv.b_test, + &inc_b, beta, data_csbmv.c_verify, &inc_c); + + BLASFUNC(csbmv)(&uplo, &n, &k, alpha, a, &lda, + data_csbmv.b_test, &inc_b, beta, data_csbmv.c_test, &inc_c); + + // Find the differences between output vector caculated by csbmv and cgemv + for (i = 0; i < n * inc_c * 2; i++) + data_csbmv.c_test[i] -= data_csbmv.c_verify[i]; + + // Find the norm of differences + return BLASFUNC(scnrm2)(&n, data_csbmv.c_test, &inc_c); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 0 + */ +CTEST(csbmv, upper_k_0_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 1 + */ +CTEST(csbmv, upper_k_1_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 1; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(csbmv, upper_k_2_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(csbmv, upper_k_2_inc_b_2_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 2 + * Number of super-diagonals k is 2 + */ +CTEST(csbmv, upper_k_2_inc_b_2_inc_c_2_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 2; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 0 + */ +CTEST(csbmv, lower_k_0_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 1 + */ +CTEST(csbmv, lower_k_1_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 1; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(csbmv, lower_k_2_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(csbmv, lower_k_2_inc_b_2_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 2 + * Number of super-diagonals k is 2 + */ +CTEST(csbmv, lower_k_2_inc_b_2_inc_c_2_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 2; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Check if output matrix a contains any NaNs + */ +CTEST(csbmv, check_for_NaN) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + + ASSERT_TRUE(norm == norm); /* NaN == NaN is false */ +} + +/** + * Test error function for an invalid param uplo. + * Uplo specifies whether a is in upper (U) or lower (L) band-packed storage mode. + */ +CTEST(csbmv, xerbla_uplo_invalid) +{ + blasint n = 1, inc_b = 1, inc_c = 1; + char uplo = 'O'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 1; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param N - + * number of rows and columns of A. Must be at least zero. + */ +CTEST(csbmv, xerbla_n_invalid) +{ + blasint n = INVALID, inc_b = 1, inc_c = 1; + char uplo = 'U'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 2; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Check if n - number of rows and columns of A equal zero. + */ +CTEST(csbmv, check_n_zero) +{ + blasint n = 0, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = 1; + char uplo = 'U'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test error function for an invalid param inc_b - + * stride of vector b_test. Can't be zero. + */ +CTEST(csbmv, xerbla_inc_b_zero) +{ + blasint n = 1, inc_b = 0, inc_c = 1; + char uplo = 'U'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 8; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param inc_c - + * stride of vector c_test. Can't be zero. + */ +CTEST(csbmv, xerbla_inc_c_zero) +{ + blasint n = 1, inc_b = 1, inc_c = 0; + char uplo = 'U'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 11; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param k - + * number of super-diagonals of A. Must be at least zero. + */ +CTEST(csbmv, xerbla_k_invalid) +{ + blasint n = 1, inc_b = 1, inc_c = 1; + char uplo = 'U'; + blasint k = INVALID; + blasint lda = 1; + int expected_info = 3; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda - + * specifies the leading dimension of a. Must be at least (k+1). + */ +CTEST(csbmv, xerbla_lda_invalid) +{ + blasint n = 1, inc_b = 1, inc_c = 1; + char uplo = 'U'; + blasint k = 0; + blasint lda = INVALID; + int expected_info = 6; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_cscal.c b/utest/test_extensions/test_cscal.c new file mode 100644 index 000000000..009c600ad --- /dev/null +++ b/utest/test_extensions/test_cscal.c @@ -0,0 +1,164 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CSCAL { + float x_test[DATASIZE * 2 * INCREMENT]; + float x_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CSCAL data_cscal; + +/** + * cscal reference code + * + * param n - number of elements of vector x + * param alpha - scaling factor for the vector product + * param x - buffer holding input vector x + * param inc - stride of vector x + */ +static void cscal_trusted(blasint n, float *alpha, float* x, blasint inc){ + blasint i, ip = 0; + blasint inc_x2 = 2 * inc; + float temp; + for (i = 0; i < n; i++) + { + temp = alpha[0] * x[ip] - alpha[1] * x[ip+1]; + x[ip+1] = alpha[0] * x[ip+1] + alpha[1] * x[ip]; + x[ip] = temp; + ip += inc_x2; + } +} + +/** + * Comapare results computed by cscal and cscal_trusted + * + * param api specifies tested api (C or Fortran) + * param n - number of elements of vector x + * param alpha - scaling factor for the vector product + * param inc - stride of vector x + * return norm of differences + */ +static float check_cscal(char api, blasint n, float *alpha, blasint inc) +{ + blasint i; + + // Fill vectors a + srand_generate(data_cscal.x_test, n * inc * 2); + + // Copy vector x for cscal_trusted + for (i = 0; i < n * 2 * inc; i++) + data_cscal.x_verify[i] = data_cscal.x_test[i]; + + cscal_trusted(n, alpha, data_cscal.x_verify, inc); + + if(api == 'F') + BLASFUNC(cscal)(&n, alpha, data_cscal.x_test, &inc); + else + cblas_cscal(n, alpha, data_cscal.x_test, inc); + + // Find the differences between output vector computed by cscal and cscal_trusted + for (i = 0; i < n * 2 * inc; i++) + data_cscal.x_verify[i] -= data_cscal.x_test[i]; + + // Find the norm of differences + return BLASFUNC(scnrm2)(&n, data_cscal.x_verify, &inc); +} + +/** + * Fortran API specific test + * Test cscal by comparing it against reference + */ +CTEST(cscal, alpha_r_zero_alpha_i_not_zero) +{ + blasint N = DATASIZE; + blasint inc = 1; + float alpha[2] = {0.0f, 1.0f}; + + float norm = check_cscal('F', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cscal by comparing it against reference + */ +CTEST(cscal, alpha_r_zero_alpha_i_zero_inc_2) +{ + blasint N = DATASIZE; + blasint inc = 2; + float alpha[2] = {0.0f, 0.0f}; + + float norm = check_cscal('F', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cscal by comparing it against reference + */ +CTEST(cscal, c_api_alpha_r_zero_alpha_i_not_zero) +{ + blasint N = DATASIZE; + blasint inc = 1; + float alpha[2] = {0.0f, 1.0f}; + + float norm = check_cscal('C', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cscal by comparing it against reference + */ +CTEST(cscal, c_api_alpha_r_zero_alpha_i_zero_inc_2) +{ + blasint N = DATASIZE; + blasint inc = 2; + float alpha[2] = {0.0f, 0.0f}; + + float norm = check_cscal('C', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_cspmv.c b/utest/test_extensions/test_cspmv.c new file mode 100644 index 000000000..b64c90e3a --- /dev/null +++ b/utest/test_extensions/test_cspmv.c @@ -0,0 +1,428 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CSPMV { + float a_verify[DATASIZE * DATASIZE * 2]; + float a_test[DATASIZE * (DATASIZE + 1)]; + float b_test[DATASIZE * 2 * INCREMENT]; + float c_test[DATASIZE * 2 * INCREMENT]; + float c_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CSPMV data_cspmv; + +/** + * Compute spmv via gemv since spmv is gemv for symmetric packed matrix + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param alpha - scaling factor for the matrix-vector product + * param a - buffer holding input matrix A + * param b - Buffer holding input vector b + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param c - buffer holding input/output vector c + * param inc_c - stride of vector c + * output param data_cspmv.c_verify - matrix computed by gemv + */ +static void cspmv_trusted(char uplo, blasint n, float *alpha, float *a, + float *b, blasint inc_b, float *beta, float *c, + blasint inc_c) +{ + blasint k; + blasint i, j; + + // param for gemv (can use any, since the input matrix is symmetric) + char trans = 'N'; + + // Unpack the input symmetric packed matrix + if (uplo == 'L') + { + k = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < n * 2; j += 2) + { + if (j / 2 < i) + { + data_cspmv.a_verify[i * n * 2 + j] = + data_cspmv.a_verify[j * n + i * 2]; + data_cspmv.a_verify[i * n * 2 + j + 1] = + data_cspmv.a_verify[j * n + i * 2 + 1]; + } + else + { + data_cspmv.a_verify[i * n * 2 + j] = a[k++]; + data_cspmv.a_verify[i * n * 2 + j + 1] = a[k++]; + } + } + } + } + else + { + k = n * (n + 1) - 1; + for (j = 2 * n - 1; j >= 0; j -= 2) + { + for (i = n - 1; i >= 0; i--) + { + if (j / 2 < i) + { + data_cspmv.a_verify[i * n * 2 + j] = + data_cspmv.a_verify[(j - 1) * n + i * 2 + 1]; + data_cspmv.a_verify[i * n * 2 + j - 1] = + data_cspmv.a_verify[(j - 1) * n + i * 2]; + } + else + { + data_cspmv.a_verify[i * n * 2 + j] = a[k--]; + data_cspmv.a_verify[i * n * 2 + j - 1] = a[k--]; + } + } + } + } + + // Run gemv with the unpacked matrix + BLASFUNC(cgemv)(&trans, &n, &n, alpha, data_cspmv.a_verify, &n, b, + &inc_b, beta, data_cspmv.c_verify, &inc_c); +} + +/** + * Comapare results computed by cspmv and cspmv_trusted + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param alpha - scaling factor for the matrix-vector product + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param inc_c - stride of vector c + * return norm of differences + */ +static float check_cspmv(char uplo, blasint n, float *alpha, blasint inc_b, + float *beta, blasint inc_c) +{ + blasint i; + + // Fill symmetric packed maxtix a, vectors b and c + srand_generate(data_cspmv.a_test, n * (n + 1)); + srand_generate(data_cspmv.b_test, 2 * n * inc_b); + srand_generate(data_cspmv.c_test, 2 * n * inc_c); + + // Copy vector c for cspmv_trusted + for (i = 0; i < n * 2 * inc_c; i++) + data_cspmv.c_verify[i] = data_cspmv.c_test[i]; + + cspmv_trusted(uplo, n, alpha, data_cspmv.a_test, data_cspmv.b_test, + inc_b, beta, data_cspmv.c_verify, inc_c); + + BLASFUNC(cspmv)(&uplo, &n, alpha, data_cspmv.a_test, data_cspmv.b_test, + &inc_b, beta, data_cspmv.c_test, &inc_c); + + // Find the differences between output vector computed by cspmv and cspmv_trusted + for (i = 0; i < n * 2 * inc_c; i++) + data_cspmv.c_test[i] -= data_cspmv.c_verify[i]; + + // Find the norm of differences + return BLASFUNC(scnrm2)(&n, data_cspmv.c_test, &inc_c); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param inc_b - stride of vector b + * param inc_c - stride of vector c + * param expected_info - expected invalid parameter number in cspmv + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char uplo, blasint n, blasint inc_b, + blasint inc_c, int expected_info) +{ + float alpha[] = {1.0, 1.0}; + float beta[] = {0.0, 0.0}; + + set_xerbla("CSPMV ", expected_info); + + BLASFUNC(cspmv)(&uplo, &n, alpha, data_cspmv.a_test, data_cspmv.b_test, + &inc_b, beta, data_cspmv.c_test, &inc_c); + + return check_error(); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cspmv, upper_inc_b_1_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 2 + */ +CTEST(cspmv, upper_inc_b_1_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 2; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 1 + */ +CTEST(cspmv, upper_inc_b_2_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 1; + char uplo = 'U'; + float alpha[] = {1.0f, 0.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(cspmv, upper_inc_b_2_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 2; + char uplo = 'U'; + float alpha[] = {2.5, -2.1}; + float beta[] = {0.0f, 1.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cspmv, lower_inc_b_1_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'L'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 2 + */ +CTEST(cspmv, lower_inc_b_1_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 2; + char uplo = 'L'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 1 + */ +CTEST(cspmv, lower_inc_b_2_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 1; + char uplo = 'L'; + float alpha[] = {1.0f, 0.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(cspmv, lower_inc_b_2_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 2; + char uplo = 'L'; + float alpha[] = {2.5, -2.1}; + float beta[] = {0.0f, 1.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Check if output matrix A contains any NaNs + */ +CTEST(cspmv, check_for_NaN) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_TRUE(norm == norm); /* NaN == NaN is false */ +} + +/** + * Test error function for an invalid param uplo. + * uplo specifies whether A is upper or lower triangular. + */ +CTEST(cspmv, xerbla_uplo_invalid) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'O'; + int expected_info = 1; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param N - + * number of rows and columns of A. Must be at least zero. + */ +CTEST(cspmv, xerbla_N_invalid) +{ + blasint N = INVALID, inc_b = 1, inc_c = 1; + char uplo = 'U'; + int expected_info = 2; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param inc_b - + * stride of vector b. Can't be zero. + */ +CTEST(cspmv, xerbla_inc_b_zero) +{ + blasint N = DATASIZE, inc_b = 0, inc_c = 1; + char uplo = 'U'; + int expected_info = 6; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param inc_c - + * stride of vector c. Can't be zero. + */ +CTEST(cspmv, xerbla_inc_c_zero) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 0; + char uplo = 'U'; + int expected_info = 9; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif diff --git a/utest/test_extensions/test_ctrmv.c b/utest/test_extensions/test_ctrmv.c new file mode 100644 index 000000000..2a3f27416 --- /dev/null +++ b/utest/test_extensions/test_ctrmv.c @@ -0,0 +1,266 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 300 +#define INCREMENT 2 + +struct DATA_CTRMV { + float a_test[DATASIZE * DATASIZE * 2]; + float a_verify[DATASIZE * DATASIZE * 2]; + float x_test[DATASIZE * INCREMENT * 2]; + float x_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CTRMV data_ctrmv; + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * + * param uplo specifies whether A is upper or lower triangular + * param trans specifies op(A), the transposition (conjugation) operation applied to A + * param diag specifies whether the matrix A is unit triangular or not. + * param n - numbers of rows and columns of A + * param lda - leading dimension of matrix A + * param incx - increment for the elements of x + * return norm of difference + */ +static float check_ctrmv(char uplo, char trans, char diag, blasint n, blasint lda, blasint incx) +{ + blasint i; + float alpha_conj[] = {1.0f, 0.0f}; + char trans_verify = trans; + + srand_generate(data_ctrmv.a_test, n * lda * 2); + srand_generate(data_ctrmv.x_test, n * incx * 2); + + for (i = 0; i < n * lda * 2; i++) + data_ctrmv.a_verify[i] = data_ctrmv.a_test[i]; + + for (i = 0; i < n * incx * 2; i++) + data_ctrmv.x_verify[i] = data_ctrmv.x_test[i]; + + if (trans == 'R'){ + cblas_cimatcopy(CblasColMajor, CblasConjNoTrans, n, n, alpha_conj, data_ctrmv.a_verify, lda, lda); + trans_verify = 'N'; + } + + BLASFUNC(ctrmv)(&uplo, &trans_verify, &diag, &n, data_ctrmv.a_verify, &lda, + data_ctrmv.x_verify, &incx); + + BLASFUNC(ctrmv)(&uplo, &trans, &diag, &n, data_ctrmv.a_test, &lda, + data_ctrmv.x_test, &incx); + + for (i = 0; i < n * incx * 2; i++) + data_ctrmv.x_verify[i] -= data_ctrmv.x_test[i]; + + return BLASFUNC(scnrm2)(&n, data_ctrmv.x_verify, &incx); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + */ +CTEST(ctrmv, conj_notrans_upper_not_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + */ +CTEST(ctrmv, conj_notrans_upper_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + */ +CTEST(ctrmv, conj_notrans_lower_not_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + */ +CTEST(ctrmv, conj_notrans_lower_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ctrmv, conj_notrans_upper_not_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ctrmv, conj_notrans_upper_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ctrmv, conj_notrans_lower_not_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ctrmv, conj_notrans_lower_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_ctrsv.c b/utest/test_extensions/test_ctrsv.c new file mode 100644 index 000000000..0e639bb2a --- /dev/null +++ b/utest/test_extensions/test_ctrsv.c @@ -0,0 +1,267 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 300 +#define INCREMENT 2 + +struct DATA_CTRSV { + float a_test[DATASIZE * DATASIZE * 2]; + float a_verify[DATASIZE * DATASIZE * 2]; + float x_test[DATASIZE * INCREMENT * 2]; + float x_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CTRSV data_ctrsv; + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * + * param uplo specifies whether A is upper or lower triangular + * param trans specifies op(A), the transposition (conjugation) operation applied to A + * param diag specifies whether the matrix A is unit triangular or not. + * param n - numbers of rows and columns of A + * param lda - leading dimension of matrix A + * param incx - increment for the elements of x + * return norm of difference + */ +static float check_ctrsv(char uplo, char trans, char diag, blasint n, blasint lda, blasint incx) +{ + blasint i; + float alpha_conj[] = {1.0f, 0.0f}; + char trans_verify = trans; + + srand_generate(data_ctrsv.a_test, n * lda * 2); + srand_generate(data_ctrsv.x_test, n * incx * 2); + + for (i = 0; i < n * lda * 2; i++) + data_ctrsv.a_verify[i] = data_ctrsv.a_test[i]; + + for (i = 0; i < n * incx * 2; i++) + data_ctrsv.x_verify[i] = data_ctrsv.x_test[i]; + + if (trans == 'R'){ + cblas_cimatcopy(CblasColMajor, CblasConjNoTrans, n, n, + alpha_conj, data_ctrsv.a_verify, lda, lda); + trans_verify = 'N'; + } + + BLASFUNC(ctrsv)(&uplo, &trans_verify, &diag, &n, data_ctrsv.a_verify, + &lda, data_ctrsv.x_verify, &incx); + + BLASFUNC(ctrsv)(&uplo, &trans, &diag, &n, data_ctrsv.a_test, &lda, + data_ctrsv.x_test, &incx); + + for (i = 0; i < n * incx * 2; i++) + data_ctrsv.x_verify[i] -= data_ctrsv.x_test[i]; + + return BLASFUNC(scnrm2)(&n, data_ctrsv.x_verify, &incx); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + */ +CTEST(ctrsv, conj_notrans_upper_not_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + */ +CTEST(ctrsv, conj_notrans_upper_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + */ +CTEST(ctrsv, conj_notrans_lower_not_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + */ +CTEST(ctrsv, conj_notrans_lower_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ctrsv, conj_notrans_upper_not_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ctrsv, conj_notrans_upper_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ctrsv, conj_notrans_lower_not_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ctrsv, conj_notrans_lower_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_damin.c b/utest/test_extensions/test_damin.c new file mode 100644 index 000000000..d492343ed --- /dev/null +++ b/utest/test_extensions/test_damin.c @@ -0,0 +1,354 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 70 +#define INCREMENT 2 + +#ifdef BUILD_DOUBLE + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.1}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.1, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, 1.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.1, 1.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.1, 1.0, -2.2}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, 2.2, 3.3}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.1, 1.0, -2.2, -3.3}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0, 3.3, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0, -3.3, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {1.1, 1.0, 2.2, 3.3, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {-1.1, 1.0, -2.2, -3.3, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0, 3.3, 0.0, 0.0, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0, -3.3, 0.0, 0.0, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0; + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0; + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 1.0; + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0; + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_daxpby.c b/utest/test_extensions/test_daxpby.c new file mode 100644 index 000000000..6e77c7c7c --- /dev/null +++ b/utest/test_extensions/test_daxpby.c @@ -0,0 +1,799 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_DAXPBY{ + double x_test[DATASIZE * INCREMENT]; + double x_verify[DATASIZE * INCREMENT]; + double y_test[DATASIZE * INCREMENT]; + double y_verify[DATASIZE * INCREMENT]; +}; + +#ifdef BUILD_DOUBLE +static struct DATA_DAXPBY data_daxpby; + +/** + * Fortran API specific function + * Test daxpby by comparing it with dscal and daxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static double check_daxpby(blasint n, double alpha, blasint incx, double beta, blasint incy) +{ + blasint i; + + // dscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Fill vectors x, y + drand_generate(data_daxpby.x_test, n * incx_abs); + drand_generate(data_daxpby.y_test, n * incy_abs); + + // Copy vector x for daxpy + for (i = 0; i < n * incx_abs; i++) + data_daxpby.x_verify[i] = data_daxpby.x_test[i]; + + // Copy vector y for dscal + for (i = 0; i < n * incy_abs; i++) + data_daxpby.y_verify[i] = data_daxpby.y_test[i]; + + // Find beta*y + BLASFUNC(dscal)(&n, &beta, data_daxpby.y_verify, &incy_abs); + + // Find sum of alpha*x and beta*y + BLASFUNC(daxpy)(&n, &alpha, data_daxpby.x_verify, &incx, + data_daxpby.y_verify, &incy); + + BLASFUNC(daxpby)(&n, &alpha, data_daxpby.x_test, &incx, + &beta, data_daxpby.y_test, &incy); + + // Find the differences between output vector caculated by daxpby and daxpy + for (i = 0; i < n * incy_abs; i++) + data_daxpby.y_test[i] -= data_daxpby.y_verify[i]; + + // Find the norm of differences + return BLASFUNC(dnrm2)(&n, data_daxpby.y_test, &incy_abs); +} + +/** + * C API specific function + * Test daxpby by comparing it with dscal and daxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static double c_api_check_daxpby(blasint n, double alpha, blasint incx, double beta, blasint incy) +{ + blasint i; + + // dscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Copy vector x for daxpy + for (i = 0; i < n * incx_abs; i++) + data_daxpby.x_verify[i] = data_daxpby.x_test[i]; + + // Copy vector y for dscal + for (i = 0; i < n * incy_abs; i++) + data_daxpby.y_verify[i] = data_daxpby.y_test[i]; + + // Find beta*y + cblas_dscal(n, beta, data_daxpby.y_verify, incy_abs); + + // Find sum of alpha*x and beta*y + cblas_daxpy(n, alpha, data_daxpby.x_verify, incx, + data_daxpby.y_verify, incy); + + cblas_daxpby(n, alpha, data_daxpby.x_test, incx, + beta, data_daxpby.y_test, incy); + + // Find the differences between output vector caculated by daxpby and daxpy + for (i = 0; i < n * incy_abs; i++) + data_daxpby.y_test[i] -= data_daxpby.y_verify[i]; + + // Find the norm of differences + return cblas_dnrm2(n, data_daxpby.y_test, incy_abs); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(daxpby, inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 1.0; + double beta = 1.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(daxpby, inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(daxpby, inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(daxpby, inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha = 3.0; + double beta = 4.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(daxpby, inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + double alpha = 5.0; + double beta = 4.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(daxpby, inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + double alpha = 1.0; + double beta = 6.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(daxpby, inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + double alpha = 7.0; + double beta = 3.5; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(daxpby, inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 0.0; + double beta = 1.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero +*/ +CTEST(daxpby, inc_x_1_inc_y_2_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 0.0; + double beta = 1.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(daxpby, inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * Scalar beta is zero +*/ +CTEST(daxpby, inc_x_2_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(daxpby, inc_x_1_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(daxpby, inc_x_2_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(daxpby, inc_x_1_inc_y_1_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 0.0; + double beta = 0.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(daxpby, inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 0.0; + double beta = 0.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(daxpby, check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + double alpha = 1.0; + double beta = 1.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(daxpby, c_api_inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 1.0; + double beta = 1.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(daxpby, c_api_inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha = 2.0; + double beta = 1.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(daxpby, c_api_inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 1.0; + double beta = 2.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(daxpby, c_api_inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha = 3.0; + double beta = 4.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(daxpby, c_api_inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + double alpha = 5.0; + double beta = 4.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(daxpby, c_api_inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + double alpha = 1.0; + double beta = 6.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(daxpby, c_api_inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + double alpha = 7.0; + double beta = 3.5; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(daxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 0.0; + double beta = 1.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero +*/ +CTEST(daxpby, c_api_inc_x_1_inc_y_2_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 0.0; + double beta = 1.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(daxpby, c_api_inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 1.0; + double beta = 0.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * Scalar beta is zero +*/ +CTEST(daxpby, c_api_inc_x_2_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha = 1.0; + double beta = 0.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(daxpby, c_api_inc_x_1_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 1.0; + double beta = 0.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(daxpby, c_api_inc_x_2_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha = 1.0; + double beta = 0.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(daxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 0.0; + double beta = 0.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(daxpby, c_api_inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 0.0; + double beta = 0.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(daxpby, c_api_check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + double alpha = 1.0; + double beta = 1.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dgeadd.c b/utest/test_extensions/test_dgeadd.c new file mode 100644 index 000000000..4654c51a3 --- /dev/null +++ b/utest/test_extensions/test_dgeadd.c @@ -0,0 +1,878 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define N 100 +#define M 100 + +struct DATA_DGEADD{ + double a_test[M * N]; + double c_test[M * N]; + double c_verify[M * N]; +}; + +#ifdef BUILD_DOUBLE +static struct DATA_DGEADD data_dgeadd; + +/** + * dgeadd reference implementation + * + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param aptr - refer to matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param cptr - refer to matrix C + * param ldc - leading dimension of C + */ +static void dgeadd_trusted(blasint m, blasint n, double alpha, double *aptr, + blasint lda, double beta, double *cptr, blasint ldc) +{ + blasint i; + + for (i = 0; i < n; i++) + { + cblas_daxpby(m, alpha, aptr, 1, beta, cptr, 1); + aptr += lda; + cptr += ldc; + } +} + +/** + * Test dgeadd by comparing it against reference + * Compare with the following options: + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static double check_dgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, double alpha, blasint lda, + double beta, blasint ldc) +{ + blasint i; + blasint cols = m, rows = n; + + if (order == CblasRowMajor) + { + rows = m; + cols = n; + } + + // Fill matrix A, C + drand_generate(data_dgeadd.a_test, lda * rows); + drand_generate(data_dgeadd.c_test, ldc * rows); + + // Copy matrix C for dgeadd + for (i = 0; i < ldc * rows; i++) + data_dgeadd.c_verify[i] = data_dgeadd.c_test[i]; + + dgeadd_trusted(cols, rows, alpha, data_dgeadd.a_test, lda, + beta, data_dgeadd.c_verify, ldc); + + if (api == 'F') + BLASFUNC(dgeadd)(&m, &n, &alpha, data_dgeadd.a_test, &lda, + &beta, data_dgeadd.c_test, &ldc); + else + cblas_dgeadd(order, m, n, alpha, data_dgeadd.a_test, lda, + beta, data_dgeadd.c_test, ldc); + + // Find the differences between output matrix caculated by dgeadd and sgemm + return dmatrix_difference(data_dgeadd.c_test, data_dgeadd.c_verify, cols, rows, ldc); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param lda - leading dimension of A + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in dgeadd + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, blasint lda, + blasint ldc, int expected_info) +{ + double alpha = 1.0; + double beta = 1.0; + + set_xerbla("DGEADD ", expected_info); + + if (api == 'F') + BLASFUNC(dgeadd)(&m, &n, &alpha, data_dgeadd.a_test, &lda, + &beta, data_dgeadd.c_test, &ldc); + else + cblas_dgeadd(order, m, n, alpha, data_dgeadd.a_test, lda, + beta, data_dgeadd.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(dgeadd, matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 3.0; + double beta = 3.0; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(dgeadd, matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 0.0; + double beta = 2.5; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(dgeadd, matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 3.0; + double beta = 0.0; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(dgeadd, matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 0.0; + double beta = 0.0; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(dgeadd, matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + double alpha = 1.0; + double beta = 1.0; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param n - + * number of columns of A and C + * Must be at least zero. + */ +CTEST(dgeadd, xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = m; + blasint ldc = m; + + int expected_info = 2; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + */ +CTEST(dgeadd, xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + */ +CTEST(dgeadd, xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 6; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + */ +CTEST(dgeadd, xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Check if n - number of columns of A, C equal zero. + */ +CTEST(dgeadd, n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + double alpha = 1.0; + double beta = 1.0; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Check if m - number of rows of A and C equal zero. + */ +CTEST(dgeadd, m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + double alpha = 1.0; + double beta = 1.0; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(dgeadd, c_api_matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 2.0; + double beta = 3.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(dgeadd, c_api_matrix_n_100_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 4.0; + double beta = 2.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(dgeadd, c_api_matrix_n_50_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N / 2; + blasint m = M; + + blasint lda = n; + blasint ldc = n; + + double alpha = 3.0; + double beta = 1.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(dgeadd, c_api_matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 0.0; + double beta = 1.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(dgeadd, c_api_matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 3.0; + double beta = 0.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(dgeadd, c_api_matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 0.0; + double beta = 0.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(dgeadd, c_api_matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + double alpha = 3.0; + double beta = 4.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test error function for an invalid param order - + * specifies whether A and C stored in + * row-major order or column-major order + */ +CTEST(dgeadd, c_api_xerbla_invalid_order) +{ + CBLAS_ORDER order = INVALID; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 0; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(dgeadd, c_api_xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(dgeadd, c_api_xerbla_n_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(dgeadd, c_api_xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(dgeadd, c_api_xerbla_m_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(dgeadd, c_api_xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(dgeadd, c_api_xerbla_lda_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(dgeadd, c_api_xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(dgeadd, c_api_xerbla_ldc_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Check if n - number of columns of A, C equal zero. + * + * c api option order is column-major order + */ +CTEST(dgeadd, c_api_n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + double alpha = 1.0; + double beta = 1.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Check if m - number of rows of A and C equal zero. + * + * c api option order is column-major order + */ +CTEST(dgeadd, c_api_m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + double alpha = 1.0; + double beta = 1.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dgemmt.c b/utest/test_extensions/test_dgemmt.c new file mode 100644 index 000000000..22dcaf2aa --- /dev/null +++ b/utest/test_extensions/test_dgemmt.c @@ -0,0 +1,1442 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_DGEMMT { + double a_test[DATASIZE * DATASIZE]; + double b_test[DATASIZE * DATASIZE]; + double c_test[DATASIZE * DATASIZE]; + double c_verify[DATASIZE * DATASIZE]; + double c_gemm[DATASIZE * DATASIZE]; +}; + +#ifdef BUILD_DOUBLE +static struct DATA_DGEMMT data_dgemmt; + +/** + * Compute gemmt via gemm since gemmt is gemm but updates only + * the upper or lower triangular part of the result matrix + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + */ +static void dgemmt_trusted(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, double alpha, blasint lda, + blasint ldb, double beta, blasint ldc) +{ + blasint i, j; + + if(api == 'F') + BLASFUNC(dgemm)(&transa, &transb, &m, &m, &k, &alpha, data_dgemmt.a_test, &lda, + data_dgemmt.b_test, &ldb, &beta, data_dgemmt.c_gemm, &ldc); + else + cblas_dgemm(order, transa, transb, m, m, k, alpha, data_dgemmt.a_test, lda, + data_dgemmt.b_test, ldb, beta, data_dgemmt.c_gemm, ldc); + + if (uplo == 'L' || uplo == CblasLower) + { + for (i = 0; i < m; i++) + for (j = i; j < m; j++) + data_dgemmt.c_verify[i * ldc + j] = + data_dgemmt.c_gemm[i * ldc + j]; + } else { + for (i = 0; i < m; i++) + for (j = 0; j <= i; j++) + data_dgemmt.c_verify[i * ldc + j] = + data_dgemmt.c_gemm[i * ldc + j]; + } +} + +/** + * Comapare results computed by dgemmt and dgemmt_trusted + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static double check_dgemmt(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, double alpha, blasint lda, + blasint ldb, double beta, blasint ldc) +{ + blasint i; + blasint b_cols; + blasint a_cols; + blasint inc = 1; + blasint size_c = m * ldc; + + if(order == CblasColMajor){ + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = m; + else a_cols = k; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = k; + else b_cols = m; + } else { + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = k; + else a_cols = m; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = m; + else b_cols = k; + } + + drand_generate(data_dgemmt.a_test, a_cols * lda); + drand_generate(data_dgemmt.b_test, b_cols * ldb); + drand_generate(data_dgemmt.c_test, m * ldc); + + for (i = 0; i < m * ldc; i++) + data_dgemmt.c_gemm[i] = data_dgemmt.c_verify[i] = data_dgemmt.c_test[i]; + + dgemmt_trusted(api, order, uplo, transa, transb, m, k, alpha, lda, ldb, beta, ldc); + + if (api == 'F') + BLASFUNC(dgemmt)(&uplo, &transa, &transb, &m, &k, &alpha, data_dgemmt.a_test, + &lda, data_dgemmt.b_test, &ldb, &beta, data_dgemmt.c_test, &ldc); + else + cblas_dgemmt(order, uplo, transa, transb, m, k, alpha, data_dgemmt.a_test, lda, + data_dgemmt.b_test, ldb, beta, data_dgemmt.c_test, ldc); + + for (i = 0; i < m * ldc; i++) + data_dgemmt.c_verify[i] -= data_dgemmt.c_test[i]; + + return BLASFUNC(dnrm2)(&size_c, data_dgemmt.c_verify, &inc) / size_c; +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in dgemmt + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, blasint lda, blasint ldb, + blasint ldc, int expected_info) +{ + double alpha = 1.0; + double beta = 0.0; + + set_xerbla("DGEMMT ", expected_info); + + if (api == 'F') + BLASFUNC(dgemmt)(&uplo, &transa, &transb, &m, &k, &alpha, data_dgemmt.a_test, + &lda, data_dgemmt.b_test, &ldb, &beta, data_dgemmt.c_test, &ldc); + else + cblas_dgemmt(order, uplo, transa, transb, m, k, alpha, data_dgemmt.a_test, lda, + data_dgemmt.b_test, ldb, beta, data_dgemmt.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(dgemmt, upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(dgemmt, upper_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(dgemmt, upper_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'T'; + char uplo = 'U'; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(dgemmt, upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'U'; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * alpha = 0.0 + */ +CTEST(dgemmt, upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + double alpha = 0.0; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * beta = 1.0 + */ +CTEST(dgemmt, upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(dgemmt, lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(dgemmt, lower_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + char transa = 'T', transb = 'N'; + char uplo = 'L'; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(dgemmt, lower_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'T'; + char uplo = 'L'; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(dgemmt, lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'L'; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * alpha = 0.0 + */ +CTEST(dgemmt, lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + double alpha = 0.0; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * beta = 1.0 + */ +CTEST(dgemmt, lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(dgemmt, c_api_colmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(dgemmt, c_api_colmajor_upper_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(dgemmt, c_api_colmajor_upper_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(dgemmt, c_api_colmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * alpha = 0.0 + */ +CTEST(dgemmt, c_api_colmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 0.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * beta = 1.0 + */ +CTEST(dgemmt, c_api_colmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(dgemmt, c_api_colmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(dgemmt, c_api_colmajor_lower_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(dgemmt, c_api_colmajor_lower_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(dgemmt, c_api_colmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * alpha = 0.0 + */ +CTEST(dgemmt, c_api_colmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 0.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * beta = 1.0 + */ +CTEST(dgemmt, c_api_colmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(dgemmt, c_api_rowmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(dgemmt, c_api_rowmajor_upper_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 100; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(dgemmt, c_api_rowmajor_upper_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 100, ldb = 100, ldc = 50; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(dgemmt, c_api_rowmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * alpha = 0.0 + */ +CTEST(dgemmt, c_api_rowmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 0.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * beta = 1.0 + */ +CTEST(dgemmt, c_api_rowmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(dgemmt, c_api_rowmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(dgemmt, c_api_rowmajor_lower_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 100; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(dgemmt, c_api_rowmajor_lower_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 100, ldb = 100, ldc = 50; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(dgemmt, c_api_rowmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * alpha = 0.0 + */ +CTEST(dgemmt, c_api_rowmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 0.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * beta = 1.0 + */ +CTEST(dgemmt, c_api_rowmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param uplo. + * Must be upper (U) or lower (L). + */ +CTEST(dgemmt, xerbla_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'O'; + int expected_info = 1; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transa. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(dgemmt, xerbla_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'O', transb = 'N'; + char uplo = 'U'; + int expected_info = 2; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transb. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(dgemmt, xerbla_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'O'; + char uplo = 'U'; + int expected_info = 3; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(dgemmt, xerbla_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 4; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(dgemmt, xerbla_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 5; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(dgemmt, xerbla_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 8; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(dgemmt, xerbla_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 10; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(dgemmt, xerbla_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 13; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. + * Test error function for an invalid param order. + * Must be column or row major. + */ +CTEST(dgemmt, xerbla_c_api_major_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 0; + + int passed = check_badargs('C', 'O', CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasColMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasRowMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B transposed. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dimatcopy.c b/utest/test_extensions/test_dimatcopy.c new file mode 100644 index 000000000..4debb50e8 --- /dev/null +++ b/utest/test_extensions/test_dimatcopy.c @@ -0,0 +1,947 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_DIMATCOPY { + double a_test[DATASIZE* DATASIZE]; + double a_verify[DATASIZE* DATASIZE]; +}; + +#ifdef BUILD_DOUBLE +static struct DATA_DIMATCOPY data_dimatcopy; + +/** + * Comapare results computed by dimatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param alpha specifies scaling factor for matrix A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * return norm of difference between openblas and reference func + */ +static double check_dimatcopy(char api, char order, char trans, blasint rows, blasint cols, double alpha, + blasint lda_src, blasint lda_dst) +{ + blasint m, n; + blasint rows_out, cols_out; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + + if (order == 'C') { + n = rows; m = cols; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + rows_out = n; cols_out = m; + } + else { + rows_out = m; cols_out = n; + } + + drand_generate(data_dimatcopy.a_test, lda_src*m); + + if (trans == 'T' || trans == 'C') { + dtranspose(m, n, alpha, data_dimatcopy.a_test, lda_src, data_dimatcopy.a_verify, lda_dst); + } + else { + dcopy(m, n, alpha, data_dimatcopy.a_test, lda_src, data_dimatcopy.a_verify, lda_dst); + } + + if (api == 'F') { + BLASFUNC(dimatcopy)(&order, &trans, &rows, &cols, &alpha, data_dimatcopy.a_test, + &lda_src, &lda_dst); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_dimatcopy(corder, ctrans, rows, cols, alpha, data_dimatcopy.a_test, + lda_src, lda_dst); + } + + // Find the differences between output matrix computed by dimatcopy and reference func + return dmatrix_difference(data_dimatcopy.a_test, data_dimatcopy.a_verify, cols_out, rows_out, lda_dst); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda_src, blasint lda_dst, int expected_info) +{ + double alpha = 1.0; + + set_xerbla("DIMATCOPY", expected_info); + + BLASFUNC(dimatcopy)(&order, &trans, &rows, &cols, &alpha, data_dimatcopy.a_test, + &lda_src, &lda_dst); + + return check_error(); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, colmajor_trans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, colmajor_notrans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, colmajor_trans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, colmajor_notrans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, colmajor_trans_col_50_row_100_alpha_one) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, colmajor_notrans_col_50_row_100_alpha_one) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, colmajor_trans_col_50_row_100_alpha_zero) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, colmajor_notrans_col_50_row_100_alpha_zero) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, rowmajor_trans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, rowmajor_notrans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, rowmajor_trans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, rowmajor_notrans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, rowmajor_trans_col_100_row_50_alpha_one) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, rowmajor_notrans_col_100_row_50_alpha_one) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, rowmajor_trans_col_100_row_50_alpha_zero) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, rowmajor_notrans_col_100_row_50_alpha_zero) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, rowmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, rowmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, c_api_colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 2.0; + + double norm = check_dimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, c_api_colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_dimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, c_api_rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha = 2.0; + + double norm = check_dimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, c_api_rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_dimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(dimatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(dimatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(dimatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda_src = 0, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(dimatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda_src = 100, lda_dst = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using row major layout, + * lda_src must be at least n. + */ +CTEST(dimatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using column major layout, + * lda_src must be at least m. + */ +CTEST(dimatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is no transposition, lda_dst must be at least n. + */ +CTEST(dimatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is transposition, lda_dst must be at least m. + */ +CTEST(dimatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is no transposition, lda_dst must be at least m. + */ +CTEST(dimatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is transposition, lda_dst must be at least n. + */ +CTEST(dimatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_domatcopy.c b/utest/test_extensions/test_domatcopy.c new file mode 100644 index 000000000..f692e8784 --- /dev/null +++ b/utest/test_extensions/test_domatcopy.c @@ -0,0 +1,672 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_DOMATCOPY { + double a_test[DATASIZE * DATASIZE]; + double b_test[DATASIZE * DATASIZE]; + double b_verify[DATASIZE * DATASIZE]; +}; + +#ifdef BUILD_DOUBLE +static struct DATA_DOMATCOPY data_domatcopy; + +/** + * Comapare results computed by domatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param alpha - scaling factor for matrix B + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * return norm of difference between openblas and reference func + */ +static double check_domatcopy(char api, char order, char trans, blasint rows, blasint cols, double alpha, + blasint lda, blasint ldb) +{ + blasint b_rows, b_cols; + blasint m, n; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + + if (order == 'C') { + m = cols; n = rows; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + b_rows = n; b_cols = m; + } + else { + b_rows = m; b_cols = n; + } + + drand_generate(data_domatcopy.a_test, lda*m); + + if (trans == 'T' || trans == 'C') { + dtranspose(m, n, alpha, data_domatcopy.a_test, lda, data_domatcopy.b_verify, ldb); + } + else { + dcopy(m, n, alpha, data_domatcopy.a_test, lda, data_domatcopy.b_verify, ldb); + } + + if (api == 'F') { + BLASFUNC(domatcopy)(&order, &trans, &rows, &cols, &alpha, data_domatcopy.a_test, + &lda, data_domatcopy.b_test, &ldb); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_domatcopy(corder, ctrans, rows, cols, alpha, data_domatcopy.a_test, + lda, data_domatcopy.b_test, ldb); + } + + return dmatrix_difference(data_domatcopy.b_test, data_domatcopy.b_verify, b_cols, b_rows, ldb); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda, blasint ldb, int expected_info) +{ + double alpha = 1.0; + + set_xerbla("DOMATCOPY", expected_info); + + BLASFUNC(domatcopy)(&order, &trans, &rows, &cols, &alpha, data_domatcopy.a_test, + &lda, data_domatcopy.b_test, &ldb); + + return check_error(); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(domatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + double alpha = 2.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific tests + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(domatcopy, colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(domatcopy, colmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 0.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(domatcopy, colmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 50; + char order = 'C'; + char trans = 'N'; + double alpha = 0.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(domatcopy, rowmajor_conjtrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + double alpha = 2.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(domatcopy, rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 50; + char order = 'R'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Matrix dimensions leave residues from 4 and 2 (specialize + * for rt case) + * alpha = 1.5 + */ +CTEST(domatcopy, rowmajor_trans_col_27_row_27) +{ + blasint m = 27, n = 27; + blasint lda = 27, ldb = 27; + char order = 'R'; + char trans = 'T'; + double alpha = 1.5; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(domatcopy, rowmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 0.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, c_api_colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_domatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, c_api_colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_domatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, c_api_rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_domatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, c_api_rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_domatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(domatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(domatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(domatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda = 0, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(domatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda = 100, ldb = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda. + * If matrices are stored using row major layout, + * lda must be at least n. + */ +CTEST(domatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda. + * If matrices are stored using column major layout, + * lda must be at least m. + */ +CTEST(domatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is no transposition, ldb must be at least n. + */ +CTEST(domatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is transposition, ldb must be at least m. + */ +CTEST(domatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is no transposition, ldb must be at least m. + */ +CTEST(domatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is transposition, ldb must be at least n. + */ +CTEST(domatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif diff --git a/utest/test_extensions/test_drotmg.c b/utest/test_extensions/test_drotmg.c new file mode 100644 index 000000000..3073c8e3e --- /dev/null +++ b/utest/test_extensions/test_drotmg.c @@ -0,0 +1,414 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#ifdef BUILD_DOUBLE + +/** + * Fortran API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, y1_zero) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0; + te_d2 = tr_d2 = 2.0; + te_x1 = tr_x1 = 8.0; + te_y1 = tr_y1 = 0.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0; + tr_d2 = 2.0; + tr_x1 = 8.0; + tr_y1 = 0.0; + + tr_param[0] = -2.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + BLASFUNC(drotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * Fortran API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, d1_negative) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = -1.0; + te_d2 = tr_d2 = 2.0; + te_x1 = tr_x1 = 8.0; + te_y1 = tr_y1 = 8.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0; + tr_d2 = 0.0; + tr_x1 = 0.0; + tr_y1 = 8.0; + + tr_param[0] = -1.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + BLASFUNC(drotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * Fortran API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, d1_positive_d2_positive_x1_zero) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0; + te_d2 = tr_d2 = 2.0; + te_x1 = tr_x1 = 0.0; + te_y1 = tr_y1 = 8.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0; + tr_d2 = 2.0; + tr_x1 = 8.0; + tr_y1 = 8.0; + + tr_param[0] = 1.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + BLASFUNC(drotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * Fortran API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, scaled_y_greater_than_scaled_x) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 1.0; + te_d2 = tr_d2 = -2.0; + te_x1 = tr_x1 = 8.0; + te_y1 = tr_y1 = 8.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0; + tr_d2 = 0.0; + tr_x1 = 0.0; + tr_y1 = 8.0; + + tr_param[0] = -1.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + BLASFUNC(drotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * C API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, c_api_y1_zero) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0; + te_d2 = tr_d2 = 2.0; + te_x1 = tr_x1 = 8.0; + te_y1 = tr_y1 = 0.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0; + tr_d2 = 2.0; + tr_x1 = 8.0; + tr_y1 = 0.0; + + tr_param[0] = -2.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + cblas_drotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * C API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, c_api_d1_negative) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = -1.0; + te_d2 = tr_d2 = 2.0; + te_x1 = tr_x1 = 8.0; + te_y1 = tr_y1 = 8.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0; + tr_d2 = 0.0; + tr_x1 = 0.0; + tr_y1 = 8.0; + + tr_param[0] = -1.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + cblas_drotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * C API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, c_api_d1_positive_d2_positive_x1_zero) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0; + te_d2 = tr_d2 = 2.0; + te_x1 = tr_x1 = 0.0; + te_y1 = tr_y1 = 8.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0; + tr_d2 = 2.0; + tr_x1 = 8.0; + tr_y1 = 8.0; + + tr_param[0] = 1.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + cblas_drotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * C API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, c_api_scaled_y_greater_than_scaled_x) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 1.0; + te_d2 = tr_d2 = -2.0; + te_x1 = tr_x1 = 8.0; + te_y1 = tr_y1 = 8.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0; + tr_d2 = 0.0; + tr_x1 = 0.0; + tr_y1 = 8.0; + + tr_param[0] = -1.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + cblas_drotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dsum.c b/utest/test_extensions/test_dsum.c new file mode 100644 index 000000000..e987c5a42 --- /dev/null +++ b/utest/test_extensions/test_dsum.c @@ -0,0 +1,403 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_DOUBLE + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, -1.0}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, -1.5, 1.0, 1.0}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.3, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, -1.0, -3.0, 2.2, 3.0}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.3, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, -2.2, 3.3}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.2, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.0, 2.0, 2.2, 2.7, -3.3, -5.9}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {0.0, 1.0, 2.2, 3.3, 0.0}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(6.5, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {0.0, 3.0, 1.0, -2.2, 2.2, -1.7, 3.3, 14.5, 0.0, -9.0}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(6.5, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(50.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, -1.0}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, -1.5, 1.0, 1.0}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(2.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(4.3, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, -1.0, -3.0, 2.2, 3.0}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(2.3, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, -2.2, 3.3}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(3.2, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.0, 2.0, 2.2, 2.7, -3.3, -5.9}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {0.0, 1.0, 2.2, 3.3, 0.0}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(6.5, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {0.0, 3.0, 1.0, -2.2, 2.2, -1.7, 3.3, 14.5, 0.0, -9.0}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(6.5, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(50.0, sum, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dzamax.c b/utest/test_extensions/test_dzamax.c new file mode 100644 index 000000000..edea3de8f --- /dev/null +++ b/utest/test_extensions/test_dzamax.c @@ -0,0 +1,294 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 70 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX16 + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, step_zero){ + blasint i; + blasint N = ELEMENTS * 2, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.0, 2.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.0, -2.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -3.0, -1.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 3.0, 1.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -3.0, -1.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0, -2.0, -2.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0, -2.0, -2.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i; + } + x[7 * inc * 2] = 1000.0; + x[7 * inc * 2 + 1] = 1000.0; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = -i; + } + x[7 * inc * 2] = 1000.0; + x[7 * inc * 2 + 1] = 1000.0; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i; + } + x[7 * inc * 2] = 1000.0; + x[7 * inc * 2 + 1] = 1000.0; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = -i; + } + x[7 * inc * 2] = 1000.0; + x[7 * inc * 2 + 1] = 1000.0; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0, amax, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dzamin.c b/utest/test_extensions/test_dzamin.c new file mode 100644 index 000000000..916eede92 --- /dev/null +++ b/utest/test_extensions/test_dzamin.c @@ -0,0 +1,310 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 70 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX16 + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, step_zero){ + blasint i; + blasint N = ELEMENTS * 2, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.0, 2.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.0, -2.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0, -2.0, -2.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0, -2.0, -2.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dzsum.c b/utest/test_extensions/test_dzsum.c new file mode 100644 index 000000000..5139f59cb --- /dev/null +++ b/utest/test_extensions/test_dzsum.c @@ -0,0 +1,403 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX16 + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1, -1.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0, 2.3, -1.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, -1.0, 2.3, -1.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.4, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, -1.5, 1.1, -1.0, 1.0, 1.0, 1.1, -1.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.6, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2, 1.1, -1.0, 0.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.4, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, -1.0, 0.0, -1.0, -3.0, -1.0, 0.0, 2.2, 3.0, -1.0, 0.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.3, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, -2.2, 3.3, 1.1, 1.0, -2.2, 3.3}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(6.4, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.1, 1.0, 1.0, 2.0, 1.1, 1.0, 2.2, 2.7, 1.1, 1.0, -3.3, -5.9}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(-0.2, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {0.0, 1.0, 2.2, 3.3, 0.0, 0.0, 1.0, 2.2, 3.3, 0.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(13.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {0.0, 3.0, 1.0, 2.2, 1.0, -2.2, 1.0, 2.2, 2.2, -1.7, 1.0, 2.2, 3.3, 14.5, 1.0, 2.2, 0.0, -9.0, 1.0, 2.2}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(11.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1, -1.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0, 2.3, -1.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, -1.0, 2.3, -1.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.4, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, -1.5, 1.1, -1.0, 1.0, 1.0, 1.1, -1.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.6, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2, 1.1, -1.0, 0.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(4.4, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, -1.0, 0.0, -1.0, -3.0, -1.0, 0.0, 2.2, 3.0, -1.0, 0.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(2.3, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, -2.2, 3.3, 1.1, 1.0, -2.2, 3.3}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(6.4, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.1, 1.0, 1.0, 2.0, 1.1, 1.0, 2.2, 2.7, 1.1, 1.0, -3.3, -5.9}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(-0.2, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {0.0, 1.0, 2.2, 3.3, 0.0, 0.0, 1.0, 2.2, 3.3, 0.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(13.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {0.0, 3.0, 1.0, 2.2, 1.0, -2.2, 1.0, 2.2, 2.2, -1.7, 1.0, 2.2, 3.3, 14.5, 1.0, 2.2, 0.0, -9.0, 1.0, 2.2}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(11.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_icamin.c b/utest/test_extensions/test_icamin.c new file mode 100644 index 000000000..cca464eac --- /dev/null +++ b/utest/test_extensions/test_icamin.c @@ -0,0 +1,625 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS * 2]; + for (i = 0; i < N * 2; i ++) { + x[i] = i - 1000; + } + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.0f, 2.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.0f, -2.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f, -2.0f, -2.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f, -2.0f, -2.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc * 2] = 0.0f; + x[(N - 1) * inc * 2 + 1] = 0.0f; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(N, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS * 2]; + for (i = 0; i < N * 2; i ++) { + x[i] = i - 1000; + } + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.0f, 2.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.0f, -2.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f, -2.0f, -2.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f, -2.0f, -2.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc * 2] = 0.0f; + x[(N - 1) * inc * 2 + 1] = 0.0f; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(N - 1, index); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_idamin.c b/utest/test_extensions/test_idamin.c new file mode 100644 index 000000000..9f099f666 --- /dev/null +++ b/utest/test_extensions/test_idamin.c @@ -0,0 +1,787 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_DOUBLE + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.1}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.1, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, 1.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.1, 1.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.1, 1.0, -2.2}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, 2.2, 3.3}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.1, 1.0, -2.2, -3.3}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0, 3.3, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0, -3.3, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {1.1, 1.0, 2.2, 3.3, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {-1.1, 1.0, -2.2, -3.3, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0, 3.3, 0.0, 0.0, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0, -3.3, 0.0, 0.0, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(N, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, min_idx_in_vec_tail_inc_1){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * inc]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0f; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(N, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.1}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.1, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, 1.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.1, 1.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.1, 1.0, -2.2}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, 2.2, 3.3}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.1, 1.0, -2.2, -3.3}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0, 3.3, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0, -3.3, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {1.1, 1.0, 2.2, 3.3, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {-1.1, 1.0, -2.2, -3.3, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0, 3.3, 0.0, 0.0, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0, -3.3, 0.0, 0.0, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(N - 1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_min_idx_in_vec_tail_inc_1){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * inc]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(N - 1, index); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_isamin.c b/utest/test_extensions/test_isamin.c new file mode 100644 index 000000000..df8dead07 --- /dev/null +++ b/utest/test_extensions/test_isamin.c @@ -0,0 +1,787 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_SINGLE + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.1f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.1f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, 1.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.1f, 1.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 3.3f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f, -3.3f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f, 3.3f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f, -3.3f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 3.3f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f, -3.3f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f, 3.3f, 0.0f, 0.0f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f, -3.3f, 0.0f, 0.0f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(N, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, min_idx_in_vec_tail_inc_1){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * inc]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(N, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.1f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.1f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, 1.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.1f, 1.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 3.3f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f, -3.3f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f, 3.3f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f, -3.3f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 3.3f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f, -3.3f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f, 3.3f, 0.0f, 0.0f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f, -3.3f, 0.0f, 0.0f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(N - 1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_min_idx_in_vec_tail_inc_1){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * inc]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(N - 1, index); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_izamin.c b/utest/test_extensions/test_izamin.c new file mode 100644 index 000000000..a0bdae8e2 --- /dev/null +++ b/utest/test_extensions/test_izamin.c @@ -0,0 +1,625 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX16 + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS * 2]; + for (i = 0; i < N * 2; i ++) { + x[i] = i - 1000; + } + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.0, 2.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.0, -2.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0, -2.0, -2.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0, -2.0, -2.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc * 2] = 0.0; + x[(N - 1) * inc * 2 + 1] = 0.0; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(N, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS * 2]; + for (i = 0; i < N * 2; i ++) { + x[i] = i - 1000; + } + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.0, 2.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.0, -2.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0, -2.0, -2.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0, -2.0, -2.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc * 2] = 0.0; + x[(N - 1) * inc * 2 + 1] = 0.0; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(N - 1, index); +} +#endif diff --git a/utest/test_extensions/test_samin.c b/utest/test_extensions/test_samin.c new file mode 100644 index 000000000..5c747a0f6 --- /dev/null +++ b/utest/test_extensions/test_samin.c @@ -0,0 +1,354 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 70 +#define INCREMENT 2 + +#ifdef BUILD_SINGLE + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.1f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.1f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, 1.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.1f, 1.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 3.3f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f, -3.3f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f, 3.3f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f, -3.3f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 3.3f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f, -3.3f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f, 3.3f, 0.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f, -3.3f, 0.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0f; + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0f; + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 1.0f; + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0f; + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_saxpby.c b/utest/test_extensions/test_saxpby.c new file mode 100644 index 000000000..b4bd5cf0b --- /dev/null +++ b/utest/test_extensions/test_saxpby.c @@ -0,0 +1,794 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_SAXPBY { + float x_test[DATASIZE * INCREMENT]; + float x_verify[DATASIZE * INCREMENT]; + float y_test[DATASIZE * INCREMENT]; + float y_verify[DATASIZE * INCREMENT]; +}; +#ifdef BUILD_SINGLE +static struct DATA_SAXPBY data_saxpby; + +/** + * Fortran API specific function + * Test saxpby by comparing it with sscal and saxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static float check_saxpby(blasint n, float alpha, blasint incx, float beta, blasint incy) +{ + blasint i; + + // sscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Fill vectors x, y + srand_generate(data_saxpby.x_test, n * incx_abs); + srand_generate(data_saxpby.y_test, n * incy_abs); + + // Copy vector x for saxpy + for (i = 0; i < n * incx_abs; i++) + data_saxpby.x_verify[i] = data_saxpby.x_test[i]; + + // Copy vector y for sscal + for (i = 0; i < n * incy_abs; i++) + data_saxpby.y_verify[i] = data_saxpby.y_test[i]; + + // Find beta*y + BLASFUNC(sscal)(&n, &beta, data_saxpby.y_verify, &incy_abs); + + // Find sum of alpha*x and beta*y + BLASFUNC(saxpy)(&n, &alpha, data_saxpby.x_verify, &incx, + data_saxpby.y_verify, &incy); + + BLASFUNC(saxpby)(&n, &alpha, data_saxpby.x_test, &incx, + &beta, data_saxpby.y_test, &incy); + + // Find the differences between output vector caculated by saxpby and saxpy + for (i = 0; i < n * incy_abs; i++) + data_saxpby.y_test[i] -= data_saxpby.y_verify[i]; + + // Find the norm of differences + return BLASFUNC(snrm2)(&n, data_saxpby.y_test, &incy_abs); +} + +/** + * C API specific function + * Test saxpby by comparing it with sscal and saxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static float c_api_check_saxpby(blasint n, float alpha, blasint incx, float beta, blasint incy) +{ + blasint i; + + // sscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Copy vector x for saxpy + for (i = 0; i < n * incx_abs; i++) + data_saxpby.x_verify[i] = data_saxpby.x_test[i]; + + // Copy vector y for sscal + for (i = 0; i < n * incy_abs; i++) + data_saxpby.y_verify[i] = data_saxpby.y_test[i]; + + // Find beta*y + cblas_sscal(n, beta, data_saxpby.y_verify, incy_abs); + + // Find sum of alpha*x and beta*y + cblas_saxpy(n, alpha, data_saxpby.x_verify, incx, + data_saxpby.y_verify, incy); + + cblas_saxpby(n, alpha, data_saxpby.x_test, incx, + beta, data_saxpby.y_test, incy); + + // Find the differences between output vector caculated by saxpby and saxpy + for (i = 0; i < n * incy_abs; i++) + data_saxpby.y_test[i] -= data_saxpby.y_verify[i]; + + // Find the norm of differences + return cblas_snrm2(n, data_saxpby.y_test, incy_abs); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(saxpby, inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(saxpby, inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(saxpby, inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(saxpby, inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha = 3.0f; + float beta = 4.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(saxpby, inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + float alpha = 5.0f; + float beta = 4.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(saxpby, inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + float alpha = 1.0f; + float beta = 6.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(saxpby, inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + float alpha = 7.0f; + float beta = 3.5f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(saxpby, inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 0.0f; + float beta = 1.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero +*/ +CTEST(saxpby, inc_x_1_inc_y_2_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 0.0f; + float beta = 1.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(saxpby, inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * Scalar beta is zero +*/ +CTEST(saxpby, inc_x_2_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(saxpby, inc_x_1_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(saxpby, inc_x_2_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(saxpby, inc_x_1_inc_y_1_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 0.0f; + float beta = 0.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(saxpby, inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 0.0f; + float beta = 0.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(saxpby, check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(saxpby, c_api_inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 1.0f; + float beta = 1.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(saxpby, c_api_inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(saxpby, c_api_inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(saxpby, c_api_inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha = 3.0f; + float beta = 4.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(saxpby, c_api_inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + float alpha = 5.0f; + float beta = 4.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(saxpby, c_api_inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + float alpha = 1.0f; + float beta = 6.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(saxpby, c_api_inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + float alpha = 7.0f; + float beta = 3.5f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(saxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 0.0f; + float beta = 1.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero +*/ +CTEST(saxpby, c_api_inc_x_1_inc_y_2_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 0.0f; + float beta = 1.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(saxpby, c_api_inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * Scalar beta is zero +*/ +CTEST(saxpby, c_api_inc_x_2_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(saxpby, c_api_inc_x_1_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(saxpby, c_api_inc_x_2_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(saxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 0.0f; + float beta = 0.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(saxpby, c_api_inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 0.0f; + float beta = 0.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(saxpby, c_api_check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + float alpha = 1.0f; + float beta = 1.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_scamax.c b/utest/test_extensions/test_scamax.c new file mode 100644 index 000000000..39d7201ff --- /dev/null +++ b/utest/test_extensions/test_scamax.c @@ -0,0 +1,294 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 70 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, step_zero){ + blasint i; + blasint N = ELEMENTS * 2, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.0f, 2.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.0f, -2.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -3.0f, -1.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 3.0f, 1.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -3.0f, -1.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f, -2.0f, -2.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f, -2.0f, -2.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i; + } + x[7 * inc * 2] = 1000.0f; + x[7 * inc * 2 + 1] = 1000.0f; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = -i; + } + x[7 * inc * 2] = 1000.0f; + x[7 * inc * 2 + 1] = 1000.0f; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i; + } + x[7 * inc * 2] = 1000.0f; + x[7 * inc * 2 + 1] = 1000.0f; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = -i; + } + x[7 * inc * 2] = 1000.0f; + x[7 * inc * 2 + 1] = 1000.0f; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0f, amax, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_scamin.c b/utest/test_extensions/test_scamin.c new file mode 100644 index 000000000..4baa23184 --- /dev/null +++ b/utest/test_extensions/test_scamin.c @@ -0,0 +1,310 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 70 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, step_zero){ + blasint i; + blasint N = ELEMENTS * 2, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.0f, 2.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.0f, -2.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f, -2.0f, -2.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f, -2.0f, -2.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_scsum.c b/utest/test_extensions/test_scsum.c new file mode 100644 index 000000000..492e1a4ca --- /dev/null +++ b/utest/test_extensions/test_scsum.c @@ -0,0 +1,403 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f, -1.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f, 2.3f, -1.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, -1.0f, 2.3f, -1.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.4f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, -1.5f, 1.1f, -1.0f, 1.0f, 1.0f, 1.1f, -1.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.6f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 1.1f, -1.0f, 0.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.4f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, -1.0f, 0.0f, -1.0f, -3.0f, -1.0f, 0.0f, 2.2f, 3.0f, -1.0f, 0.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.3f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, -2.2f, 3.3f, 1.1f, 1.0f, -2.2f, 3.3f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(6.4f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.1f, 1.0f, 1.0f, 2.0f, 1.1f, 1.0f, 2.2f, 2.7f, 1.1f, 1.0f, -3.3f, -5.9f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(-0.2f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {0.0f, 1.0f, 2.2f, 3.3f, 0.0f, 0.0f, 1.0f, 2.2f, 3.3f, 0.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(13.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {0.0f, 3.0f, 1.0f, 2.2f, 1.0f, -2.2f, 1.0f, 2.2f, 2.2f, -1.7f, 1.0f, 2.2f, 3.3f, 14.5f, 1.0f, 2.2f, 0.0f, -9.0f, 1.0f, 2.2f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(11.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f, -1.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f, 2.3f, -1.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, -1.0f, 2.3f, -1.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.4f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, -1.5f, 1.1f, -1.0f, 1.0f, 1.0f, 1.1f, -1.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.6f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 1.1f, -1.0f, 0.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(4.4f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, -1.0f, 0.0f, -1.0f, -3.0f, -1.0f, 0.0f, 2.2f, 3.0f, -1.0f, 0.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(2.3f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, -2.2f, 3.3f, 1.1f, 1.0f, -2.2f, 3.3f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(6.4f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.1f, 1.0f, 1.0f, 2.0f, 1.1f, 1.0f, 2.2f, 2.7f, 1.1f, 1.0f, -3.3f, -5.9f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(-0.2f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {0.0f, 1.0f, 2.2f, 3.3f, 0.0f, 0.0f, 1.0f, 2.2f, 3.3f, 0.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(13.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {0.0f, 3.0f, 1.0f, 2.2f, 1.0f, -2.2f, 1.0f, 2.2f, 2.2f, -1.7f, 1.0f, 2.2f, 3.3f, 14.5f, 1.0f, 2.2f, 0.0f, -9.0f, 1.0f, 2.2f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(11.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_sgeadd.c b/utest/test_extensions/test_sgeadd.c new file mode 100644 index 000000000..b42ce9c0e --- /dev/null +++ b/utest/test_extensions/test_sgeadd.c @@ -0,0 +1,880 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define N 100 +#define M 100 + +struct DATA_SGEADD +{ + float a_test[M * N]; + float c_test[M * N]; + float c_verify[M * N]; +}; + +#ifdef BUILD_SINGLE +static struct DATA_SGEADD data_sgeadd; + +/** + * sgeadd reference implementation + * + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param aptr - refer to matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param cptr - refer to matrix C + * param ldc - leading dimension of C + */ +static void sgeadd_trusted(blasint m, blasint n, float alpha, float *aptr, + blasint lda, float beta, float *cptr, blasint ldc) +{ + blasint i; + + for (i = 0; i < n; i++) + { + cblas_saxpby(m, alpha, aptr, 1, beta, cptr, 1); + aptr += lda; + cptr += ldc; + } +} + +/** + * Test sgeadd by comparing it against reference + * Compare with the following options: + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static float check_sgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, float alpha, blasint lda, + float beta, blasint ldc) +{ + blasint i; + blasint cols = m, rows = n; + + if (order == CblasRowMajor) + { + rows = m; + cols = n; + } + + // Fill matrix A, C + srand_generate(data_sgeadd.a_test, lda * rows); + srand_generate(data_sgeadd.c_test, ldc * rows); + + // Copy matrix C for sgeadd + for (i = 0; i < ldc * rows; i++) + data_sgeadd.c_verify[i] = data_sgeadd.c_test[i]; + + sgeadd_trusted(cols, rows, alpha, data_sgeadd.a_test, lda, + beta, data_sgeadd.c_verify, ldc); + + if (api == 'F') + BLASFUNC(sgeadd) + (&m, &n, &alpha, data_sgeadd.a_test, &lda, + &beta, data_sgeadd.c_test, &ldc); + else + cblas_sgeadd(order, m, n, alpha, data_sgeadd.a_test, lda, + beta, data_sgeadd.c_test, ldc); + + // Find the differences between output matrix caculated by sgeadd and sgemm + return smatrix_difference(data_sgeadd.c_test, data_sgeadd.c_verify, cols, rows, ldc); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param lda - leading dimension of A + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in sgeadd + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, blasint lda, + blasint ldc, int expected_info) +{ + float alpha = 1.0f; + float beta = 1.0f; + + set_xerbla("SGEADD ", expected_info); + + if (api == 'F') + BLASFUNC(sgeadd) + (&m, &n, &alpha, data_sgeadd.a_test, &lda, + &beta, data_sgeadd.c_test, &ldc); + else + cblas_sgeadd(order, m, n, alpha, data_sgeadd.a_test, lda, + beta, data_sgeadd.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(sgeadd, matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 3.0f; + float beta = 3.0f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(sgeadd, matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 0.0f; + float beta = 2.5f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(sgeadd, matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 3.0f; + float beta = 0.0f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(sgeadd, matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 0.0f; + float beta = 0.0f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(sgeadd, matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param n - + * number of columns of A and C + * Must be at least zero. + */ +CTEST(sgeadd, xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = m; + blasint ldc = m; + + int expected_info = 2; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + */ +CTEST(sgeadd, xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + */ +CTEST(sgeadd, xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 6; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + */ +CTEST(sgeadd, xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Check if n - number of columns of A, C equal zero. + */ +CTEST(sgeadd, n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Check if m - number of rows of A and C equal zero. + */ +CTEST(sgeadd, m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(sgeadd, c_api_matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 2.0f; + float beta = 3.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(sgeadd, c_api_matrix_n_100_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 4.0f; + float beta = 2.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(sgeadd, c_api_matrix_n_50_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N / 2; + blasint m = M; + + blasint lda = n; + blasint ldc = n; + + float alpha = 3.0f; + float beta = 1.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(sgeadd, c_api_matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 0.0f; + float beta = 1.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(sgeadd, c_api_matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 3.0f; + float beta = 0.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(sgeadd, c_api_matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 0.0f; + float beta = 0.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(sgeadd, c_api_matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + float alpha = 3.0f; + float beta = 4.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test error function for an invalid param order - + * specifies whether A and C stored in + * row-major order or column-major order + */ +CTEST(sgeadd, c_api_xerbla_invalid_order) +{ + CBLAS_ORDER order = INVALID; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 0; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(sgeadd, c_api_xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(sgeadd, c_api_xerbla_n_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(sgeadd, c_api_xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(sgeadd, c_api_xerbla_m_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(sgeadd, c_api_xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(sgeadd, c_api_xerbla_lda_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(sgeadd, c_api_xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(sgeadd, c_api_xerbla_ldc_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Check if n - number of columns of A, C equal zero. + * + * c api option order is column-major order + */ +CTEST(sgeadd, c_api_n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Check if m - number of rows of A and C equal zero. + * + * c api option order is column-major order + */ +CTEST(sgeadd, c_api_m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_sgemmt.c b/utest/test_extensions/test_sgemmt.c new file mode 100644 index 000000000..5b51e3579 --- /dev/null +++ b/utest/test_extensions/test_sgemmt.c @@ -0,0 +1,1442 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_SGEMMT { + float a_test[DATASIZE * DATASIZE]; + float b_test[DATASIZE * DATASIZE]; + float c_test[DATASIZE * DATASIZE]; + float c_verify[DATASIZE * DATASIZE]; + float c_gemm[DATASIZE * DATASIZE]; +}; + +#ifdef BUILD_SINGLE +static struct DATA_SGEMMT data_sgemmt; + +/** + * Compute gemmt via gemm since gemmt is gemm but updates only + * the upper or lower triangular part of the result matrix + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + */ +static void sgemmt_trusted(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, float alpha, blasint lda, + blasint ldb, float beta, blasint ldc) +{ + blasint i, j; + + if(api == 'F') + BLASFUNC(sgemm)(&transa, &transb, &m, &m, &k, &alpha, data_sgemmt.a_test, &lda, + data_sgemmt.b_test, &ldb, &beta, data_sgemmt.c_gemm, &ldc); + else + cblas_sgemm(order, transa, transb, m, m, k, alpha, data_sgemmt.a_test, lda, + data_sgemmt.b_test, ldb, beta, data_sgemmt.c_gemm, ldc); + + if (uplo == 'L' || uplo == CblasLower) + { + for (i = 0; i < m; i++) + for (j = i; j < m; j++) + data_sgemmt.c_verify[i * ldc + j] = + data_sgemmt.c_gemm[i * ldc + j]; + } else { + for (i = 0; i < m; i++) + for (j = 0; j <= i; j++) + data_sgemmt.c_verify[i * ldc + j] = + data_sgemmt.c_gemm[i * ldc + j]; + } +} + +/** + * Comapare results computed by sgemmt and sgemmt_trusted + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static float check_sgemmt(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, float alpha, blasint lda, + blasint ldb, float beta, blasint ldc) +{ + blasint i; + blasint b_cols; + blasint a_cols; + blasint inc = 1; + blasint size_c = m * ldc; + + if(order == CblasColMajor){ + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = m; + else a_cols = k; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = k; + else b_cols = m; + } else { + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = k; + else a_cols = m; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = m; + else b_cols = k; + } + + srand_generate(data_sgemmt.a_test, a_cols * lda); + srand_generate(data_sgemmt.b_test, b_cols * ldb); + srand_generate(data_sgemmt.c_test, m * ldc); + + for (i = 0; i < m * ldc; i++) + data_sgemmt.c_gemm[i] = data_sgemmt.c_verify[i] = data_sgemmt.c_test[i]; + + sgemmt_trusted(api, order, uplo, transa, transb, m, k, alpha, lda, ldb, beta, ldc); + + if (api == 'F') + BLASFUNC(sgemmt)(&uplo, &transa, &transb, &m, &k, &alpha, data_sgemmt.a_test, + &lda, data_sgemmt.b_test, &ldb, &beta, data_sgemmt.c_test, &ldc); + else + cblas_sgemmt(order, uplo, transa, transb, m, k, alpha, data_sgemmt.a_test, lda, + data_sgemmt.b_test, ldb, beta, data_sgemmt.c_test, ldc); + + for (i = 0; i < m * ldc; i++) + data_sgemmt.c_verify[i] -= data_sgemmt.c_test[i]; + + return BLASFUNC(snrm2)(&size_c, data_sgemmt.c_verify, &inc) / size_c; +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in sgemmt + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, blasint lda, blasint ldb, + blasint ldc, int expected_info) +{ + float alpha = 1.0f; + float beta = 0.0f; + + set_xerbla("SGEMMT ", expected_info); + + if (api == 'F') + BLASFUNC(sgemmt)(&uplo, &transa, &transb, &m, &k, &alpha, data_sgemmt.a_test, + &lda, data_sgemmt.b_test, &ldb, &beta, data_sgemmt.c_test, &ldc); + else + cblas_sgemmt(order, uplo, transa, transb, m, k, alpha, data_sgemmt.a_test, lda, + data_sgemmt.b_test, ldb, beta, data_sgemmt.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(sgemmt, upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(sgemmt, upper_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(sgemmt, upper_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'T'; + char uplo = 'U'; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(sgemmt, upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'U'; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * alpha = 0.0 + */ +CTEST(sgemmt, upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + float alpha = 0.0f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * beta = 1.0 + */ +CTEST(sgemmt, upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(sgemmt, lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(sgemmt, lower_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + char transa = 'T', transb = 'N'; + char uplo = 'L'; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(sgemmt, lower_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'T'; + char uplo = 'L'; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(sgemmt, lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'L'; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * alpha = 0.0 + */ +CTEST(sgemmt, lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + float alpha = 0.0f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * beta = 1.0 + */ +CTEST(sgemmt, lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(sgemmt, c_api_colmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(sgemmt, c_api_colmajor_upper_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(sgemmt, c_api_colmajor_upper_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(sgemmt, c_api_colmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * alpha = 0.0 + */ +CTEST(sgemmt, c_api_colmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 0.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * beta = 1.0 + */ +CTEST(sgemmt, c_api_colmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(sgemmt, c_api_colmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(sgemmt, c_api_colmajor_lower_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(sgemmt, c_api_colmajor_lower_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(sgemmt, c_api_colmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * alpha = 0.0 + */ +CTEST(sgemmt, c_api_colmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 0.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * beta = 1.0 + */ +CTEST(sgemmt, c_api_colmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(sgemmt, c_api_rowmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(sgemmt, c_api_rowmajor_upper_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 100; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(sgemmt, c_api_rowmajor_upper_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 100, ldb = 100, ldc = 50; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(sgemmt, c_api_rowmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * alpha = 0.0 + */ +CTEST(sgemmt, c_api_rowmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 0.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * beta = 1.0 + */ +CTEST(sgemmt, c_api_rowmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(sgemmt, c_api_rowmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(sgemmt, c_api_rowmajor_lower_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 100; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(sgemmt, c_api_rowmajor_lower_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 100, ldb = 100, ldc = 50; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(sgemmt, c_api_rowmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * alpha = 0.0 + */ +CTEST(sgemmt, c_api_rowmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 0.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * beta = 1.0 + */ +CTEST(sgemmt, c_api_rowmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param uplo. + * Must be upper (U) or lower (L). + */ +CTEST(sgemmt, xerbla_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'O'; + int expected_info = 1; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transa. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(sgemmt, xerbla_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'O', transb = 'N'; + char uplo = 'U'; + int expected_info = 2; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transb. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(sgemmt, xerbla_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'O'; + char uplo = 'U'; + int expected_info = 3; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(sgemmt, xerbla_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 4; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(sgemmt, xerbla_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 5; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(sgemmt, xerbla_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 8; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(sgemmt, xerbla_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 10; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(sgemmt, xerbla_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 13; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. + * Test error function for an invalid param order. + * Must be column or row major. + */ +CTEST(sgemmt, xerbla_c_api_major_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 0; + + int passed = check_badargs('C', 'O', CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasColMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasRowMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B transposed. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_simatcopy.c b/utest/test_extensions/test_simatcopy.c new file mode 100644 index 000000000..0d9c44e73 --- /dev/null +++ b/utest/test_extensions/test_simatcopy.c @@ -0,0 +1,947 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_SIMATCOPY { + float a_test[DATASIZE* DATASIZE]; + float a_verify[DATASIZE* DATASIZE]; +}; + +#ifdef BUILD_SINGLE +static struct DATA_SIMATCOPY data_simatcopy; + +/** + * Comapare results computed by simatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param alpha specifies scaling factor for matrix A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * return norm of difference between openblas and reference func + */ +static float check_simatcopy(char api, char order, char trans, blasint rows, blasint cols, float alpha, + blasint lda_src, blasint lda_dst) +{ + blasint m, n; + blasint rows_out, cols_out; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + + if (order == 'C') { + n = rows; m = cols; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + rows_out = n; cols_out = m; + } + else { + rows_out = m; cols_out = n; + } + + srand_generate(data_simatcopy.a_test, lda_src*m); + + if (trans == 'T' || trans == 'C') { + stranspose(m, n, alpha, data_simatcopy.a_test, lda_src, data_simatcopy.a_verify, lda_dst); + } + else { + scopy(m, n, alpha, data_simatcopy.a_test, lda_src, data_simatcopy.a_verify, lda_dst); + } + + if (api == 'F') { + BLASFUNC(simatcopy)(&order, &trans, &rows, &cols, &alpha, data_simatcopy.a_test, + &lda_src, &lda_dst); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_simatcopy(corder, ctrans, rows, cols, alpha, data_simatcopy.a_test, + lda_src, lda_dst); + } + + // Find the differences between output matrix computed by simatcopy and reference func + return smatrix_difference(data_simatcopy.a_test, data_simatcopy.a_verify, cols_out, rows_out, lda_dst); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda_src, blasint lda_dst, int expected_info) +{ + float alpha = 1.0f; + + set_xerbla("SIMATCOPY", expected_info); + + BLASFUNC(simatcopy)(&order, &trans, &rows, &cols, &alpha, data_simatcopy.a_test, + &lda_src, &lda_dst); + + return check_error(); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 1.0f + */ +CTEST(simatcopy, colmajor_trans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 1.0f + */ +CTEST(simatcopy, colmajor_notrans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 0.0f + */ +CTEST(simatcopy, colmajor_trans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 0.0f + */ +CTEST(simatcopy, colmajor_notrans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 1.0f + */ +CTEST(simatcopy, colmajor_trans_col_50_row_100_alpha_one) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 1.0f + */ +CTEST(simatcopy, colmajor_notrans_col_50_row_100_alpha_one) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 0.0f + */ +CTEST(simatcopy, colmajor_trans_col_50_row_100_alpha_zero) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 0.0f + */ +CTEST(simatcopy, colmajor_notrans_col_50_row_100_alpha_zero) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 2.0f + */ +CTEST(simatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 2.0f + */ +CTEST(simatcopy, colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 1.0f + */ +CTEST(simatcopy, rowmajor_trans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 1.0f + */ +CTEST(simatcopy, rowmajor_notrans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 0.0f + */ +CTEST(simatcopy, rowmajor_trans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 0.0f + */ +CTEST(simatcopy, rowmajor_notrans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific tests + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 1.0f + */ +CTEST(simatcopy, rowmajor_trans_col_100_row_50_alpha_one) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 1.0f + */ +CTEST(simatcopy, rowmajor_notrans_col_100_row_50_alpha_one) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 0.0f + */ +CTEST(simatcopy, rowmajor_trans_col_100_row_50_alpha_zero) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 0.0f + */ +CTEST(simatcopy, rowmajor_notrans_col_100_row_50_alpha_zero) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 2.0f + */ +CTEST(simatcopy, rowmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 2.0f + */ +CTEST(simatcopy, rowmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, c_api_colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 2.0f; + + float norm = check_simatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, c_api_colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_simatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, c_api_rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha = 2.0f; + + float norm = check_simatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, c_api_rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_simatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(simatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(simatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(simatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda_src = 0, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(simatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda_src = 100, lda_dst = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using row major layout, + * lda_src must be at least n. + */ +CTEST(simatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using column major layout, + * lda_src must be at least m. + */ +CTEST(simatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is no transposition, lda_dst must be at least n. + */ +CTEST(simatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is transposition, lda_dst must be at least m. + */ +CTEST(simatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is no transposition, lda_dst must be at least m. + */ +CTEST(simatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is transposition, lda_dst must be at least n. + */ +CTEST(simatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_somatcopy.c b/utest/test_extensions/test_somatcopy.c new file mode 100644 index 000000000..c75bbc75e --- /dev/null +++ b/utest/test_extensions/test_somatcopy.c @@ -0,0 +1,672 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_SOMATCOPY { + float a_test[DATASIZE * DATASIZE]; + float b_test[DATASIZE * DATASIZE]; + float b_verify[DATASIZE * DATASIZE]; +}; + +#ifdef BUILD_SINGLE +static struct DATA_SOMATCOPY data_somatcopy; + +/** + * Comapare results computed by somatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param alpha - scaling factor for matrix B + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * return norm of difference between openblas and reference func + */ +static float check_somatcopy(char api, char order, char trans, blasint rows, blasint cols, float alpha, + blasint lda, blasint ldb) +{ + blasint b_rows, b_cols; + blasint m, n; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + + if (order == 'C') { + m = cols; n = rows; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + b_rows = n; b_cols = m; + } + else { + b_rows = m; b_cols = n; + } + + srand_generate(data_somatcopy.a_test, lda*m); + + if (trans == 'T' || trans == 'C') { + stranspose(m, n, alpha, data_somatcopy.a_test, lda, data_somatcopy.b_verify, ldb); + } + else { + scopy(m, n, alpha, data_somatcopy.a_test, lda, data_somatcopy.b_verify, ldb); + } + + if (api == 'F') { + BLASFUNC(somatcopy)(&order, &trans, &rows, &cols, &alpha, data_somatcopy.a_test, + &lda, data_somatcopy.b_test, &ldb); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_somatcopy(corder, ctrans, rows, cols, alpha, data_somatcopy.a_test, + lda, data_somatcopy.b_test, ldb); + } + + return smatrix_difference(data_somatcopy.b_test, data_somatcopy.b_verify, b_cols, b_rows, ldb); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda, blasint ldb, int expected_info) +{ + float alpha = 1.0; + + set_xerbla("SOMATCOPY", expected_info); + + BLASFUNC(somatcopy)(&order, &trans, &rows, &cols, &alpha, data_somatcopy.a_test, + &lda, data_somatcopy.b_test, &ldb); + + return check_error(); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(somatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + float alpha = 2.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(somatcopy, colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(somatcopy, colmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 0.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(somatcopy, colmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 50; + char order = 'C'; + char trans = 'N'; + float alpha = 0.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(somatcopy, rowmajor_conjtrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + float alpha = 2.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(somatcopy, rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 50; + char order = 'R'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Matrix dimensions leave residues from 4 and 2 (specialize + * for rt case) + * alpha = 1.5 + */ +CTEST(somatcopy, rowmajor_trans_col_27_row_27) +{ + blasint m = 27, n = 27; + blasint lda = 27, ldb = 27; + char order = 'R'; + char trans = 'T'; + float alpha = 1.5f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(somatcopy, rowmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 0.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, c_api_colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_somatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, c_api_colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_somatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, c_api_rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_somatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, c_api_rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_somatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(somatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(somatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(somatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda = 0, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(somatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda = 100, ldb = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda. + * If matrices are stored using row major layout, + * lda must be at least n. + */ +CTEST(somatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda. + * If matrices are stored using column major layout, + * lda must be at least m. + */ +CTEST(somatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is no transposition, ldb must be at least n. + */ +CTEST(somatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is transposition, ldb must be at least m. + */ +CTEST(somatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is no transposition, ldb must be at least m. + */ +CTEST(somatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is transposition, ldb must be at least n. + */ +CTEST(somatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif diff --git a/utest/test_extensions/test_srotmg.c b/utest/test_extensions/test_srotmg.c new file mode 100644 index 000000000..3c97e3b4d --- /dev/null +++ b/utest/test_extensions/test_srotmg.c @@ -0,0 +1,414 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#ifdef BUILD_SINGLE + +/** + * Fortran API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, y1_zero) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0f; + te_d2 = tr_d2 = 2.0f; + te_x1 = tr_x1 = 8.0f; + te_y1 = tr_y1 = 0.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0f; + tr_d2 = 2.0f; + tr_x1 = 8.0f; + tr_y1 = 0.0f; + + tr_param[0] = -2.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + BLASFUNC(srotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * Fortran API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, d1_negative) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = -1.0f; + te_d2 = tr_d2 = 2.0f; + te_x1 = tr_x1 = 8.0f; + te_y1 = tr_y1 = 8.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0f; + tr_d2 = 0.0f; + tr_x1 = 0.0f; + tr_y1 = 8.0f; + + tr_param[0] = -1.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + BLASFUNC(srotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * Fortran API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, d1_positive_d2_positive_x1_zero) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0f; + te_d2 = tr_d2 = 2.0f; + te_x1 = tr_x1 = 0.0f; + te_y1 = tr_y1 = 8.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0f; + tr_d2 = 2.0f; + tr_x1 = 8.0f; + tr_y1 = 8.0f; + + tr_param[0] = 1.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + BLASFUNC(srotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * Fortran API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, scaled_y_greater_than_scaled_x) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 1.0f; + te_d2 = tr_d2 = -2.0f; + te_x1 = tr_x1 = 8.0f; + te_y1 = tr_y1 = 8.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0f; + tr_d2 = 0.0f; + tr_x1 = 0.0f; + tr_y1 = 8.0f; + + tr_param[0] = -1.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + BLASFUNC(srotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * C API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, c_api_y1_zero) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0f; + te_d2 = tr_d2 = 2.0f; + te_x1 = tr_x1 = 8.0f; + te_y1 = tr_y1 = 0.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0f; + tr_d2 = 2.0f; + tr_x1 = 8.0f; + tr_y1 = 0.0f; + + tr_param[0] = -2.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + cblas_srotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * C API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, c_api_d1_negative) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = -1.0f; + te_d2 = tr_d2 = 2.0f; + te_x1 = tr_x1 = 8.0f; + te_y1 = tr_y1 = 8.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0f; + tr_d2 = 0.0f; + tr_x1 = 0.0f; + tr_y1 = 8.0f; + + tr_param[0] = -1.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + cblas_srotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * C API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, c_api_d1_positive_d2_positive_x1_zero) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0f; + te_d2 = tr_d2 = 2.0f; + te_x1 = tr_x1 = 0.0f; + te_y1 = tr_y1 = 8.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0f; + tr_d2 = 2.0f; + tr_x1 = 8.0f; + tr_y1 = 8.0f; + + tr_param[0] = 1.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + cblas_srotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * C API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, c_api_scaled_y_greater_than_scaled_x) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 1.0f; + te_d2 = tr_d2 = -2.0f; + te_x1 = tr_x1 = 8.0f; + te_y1 = tr_y1 = 8.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0f; + tr_d2 = 0.0f; + tr_x1 = 0.0f; + tr_y1 = 8.0f; + + tr_param[0] = -1.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + cblas_srotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_ssum.c b/utest/test_extensions/test_ssum.c new file mode 100644 index 000000000..971a0d2e0 --- /dev/null +++ b/utest/test_extensions/test_ssum.c @@ -0,0 +1,403 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_SINGLE + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, -1.0f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, -1.5f, 1.0f, 1.0f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.3f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, -1.0f, -3.0f, 2.2f, 3.0f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.3f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, -2.2f, 3.3f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.2f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 2.0f, 2.2f, 2.7f, -3.3f, -5.9f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {0.0f, 1.0f, 2.2f, 3.3f, 0.0f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(6.5f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {0.0f, 3.0f, 1.0f, -2.2f, 2.2f, -1.7f, 3.3f, 14.5f, 0.0f, -9.0f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(6.5f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(50.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, -1.0f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, -1.5f, 1.0f, 1.0f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(2.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(4.3f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, -1.0f, -3.0f, 2.2f, 3.0f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(2.3f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, -2.2f, 3.3f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(3.2f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 2.0f, 2.2f, 2.7f, -3.3f, -5.9f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {0.0f, 1.0f, 2.2f, 3.3f, 0.0f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(6.5f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {0.0f, 3.0f, 1.0f, -2.2f, 2.2f, -1.7f, 3.3f, 14.5f, 0.0f, -9.0f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(6.5f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(50.0f, sum, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zaxpby.c b/utest/test_extensions/test_zaxpby.c new file mode 100644 index 000000000..6148f44c5 --- /dev/null +++ b/utest/test_extensions/test_zaxpby.c @@ -0,0 +1,630 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZAXPBY { + double x_test[DATASIZE * INCREMENT * 2]; + double x_verify[DATASIZE * INCREMENT * 2]; + double y_test[DATASIZE * INCREMENT * 2]; + double y_verify[DATASIZE * INCREMENT * 2]; +}; +#ifdef BUILD_COMPLEX16 +static struct DATA_ZAXPBY data_zaxpby; + +/** + * Fortran API specific function + * Test zaxpby by comparing it with zscal and zaxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static double check_zaxpby(blasint n, double *alpha, blasint incx, double *beta, blasint incy) +{ + blasint i; + + // zscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Fill vectors x, y + drand_generate(data_zaxpby.x_test, n * incx_abs * 2); + drand_generate(data_zaxpby.y_test, n * incy_abs * 2); + + // Copy vector x for zaxpy + for (i = 0; i < n * incx_abs * 2; i++) + data_zaxpby.x_verify[i] = data_zaxpby.x_test[i]; + + // Copy vector y for zscal + for (i = 0; i < n * incy_abs * 2; i++) + data_zaxpby.y_verify[i] = data_zaxpby.y_test[i]; + + // Find beta*y + BLASFUNC(zscal)(&n, beta, data_zaxpby.y_verify, &incy_abs); + + // Find sum of alpha*x and beta*y + BLASFUNC(zaxpy)(&n, alpha, data_zaxpby.x_verify, &incx, + data_zaxpby.y_verify, &incy); + + BLASFUNC(zaxpby)(&n, alpha, data_zaxpby.x_test, &incx, + beta, data_zaxpby.y_test, &incy); + + // Find the differences between output vector caculated by zaxpby and zaxpy + for (i = 0; i < n * incy_abs * 2; i++) + data_zaxpby.y_test[i] -= data_zaxpby.y_verify[i]; + + // Find the norm of differences + return BLASFUNC(dznrm2)(&n, data_zaxpby.y_test, &incy_abs); +} + +/** + * C API specific function + * Test zaxpby by comparing it with zscal and zaxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static double c_api_check_zaxpby(blasint n, double *alpha, blasint incx, double *beta, blasint incy) +{ + blasint i; + + // zscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Fill vectors x, y + drand_generate(data_zaxpby.x_test, n * incx_abs * 2); + drand_generate(data_zaxpby.y_test, n * incy_abs * 2); + + // Copy vector x for zaxpy + for (i = 0; i < n * incx_abs * 2; i++) + data_zaxpby.x_verify[i] = data_zaxpby.x_test[i]; + + // Copy vector y for zscal + for (i = 0; i < n * incy_abs * 2; i++) + data_zaxpby.y_verify[i] = data_zaxpby.y_test[i]; + + // Find beta*y + cblas_zscal(n, beta, data_zaxpby.y_verify, incy_abs); + + // Find sum of alpha*x and beta*y + cblas_zaxpy(n, alpha, data_zaxpby.x_verify, incx, + data_zaxpby.y_verify, incy); + + cblas_zaxpby(n, alpha, data_zaxpby.x_test, incx, + beta, data_zaxpby.y_test, incy); + + // Find the differences between output vector caculated by zaxpby and zaxpy + for (i = 0; i < n * incy_abs * 2; i++) + data_zaxpby.y_test[i] -= data_zaxpby.y_verify[i]; + + // Find the norm of differences + return cblas_dznrm2(n, data_zaxpby.y_test, incy_abs); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(zaxpby, inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(zaxpby, inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(zaxpby, inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(zaxpby, inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha[] = {3.0, 1.0}; + double beta[] = {4.0, 3.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(zaxpby, inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + double alpha[] = {5.0, 2.2}; + double beta[] = {4.0, 5.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(zaxpby, inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + double alpha[] = {1.0, 1.0}; + double beta[] = {6.0, 3.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(zaxpby, inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + double alpha[] = {7.0, 2.0}; + double beta[] = {3.5, 1.3}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(zaxpby, inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {0.0, 0.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(zaxpby, inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(zaxpby, inc_x_1_inc_y_1_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {0.0, 0.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(zaxpby, inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha[] = {0.0, 0.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(zaxpby, check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(zaxpby, c_api_inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(zaxpby, c_api_inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(zaxpby, c_api_inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 2.1}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(zaxpby, c_api_inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha[] = {3.0, 2.0}; + double beta[] = {4.0, 3.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(zaxpby, c_api_inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + double alpha[] = {5.0, 2.0}; + double beta[] = {4.0, 3.1}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(zaxpby, c_api_inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + double alpha[] = {1.0, 1.0}; + double beta[] = {6.0, 2.3}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(zaxpby, c_api_inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + double alpha[] = {7.0, 1.0}; + double beta[] = {3.5, 1.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(zaxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {0.0, 0.0}; + double beta[] = {1.0, 1.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(zaxpby, c_api_inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(zaxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {0.0, 0.0}; + double beta[] = {0.0, 0.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(zaxpby, c_api_inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha[] = {0.0, 0.0}; + double beta[] = {0.0, 0.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(zaxpby, c_api_check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif diff --git a/utest/test_extensions/test_zaxpyc.c b/utest/test_extensions/test_zaxpyc.c new file mode 100644 index 000000000..7c11cd920 --- /dev/null +++ b/utest/test_extensions/test_zaxpyc.c @@ -0,0 +1,159 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZAXPYC { + double x_test[DATASIZE * INCREMENT * 2]; + double x_verify[DATASIZE * INCREMENT * 2]; + double y_test[DATASIZE * INCREMENT * 2]; + double y_verify[DATASIZE * INCREMENT * 2]; +}; +#ifdef BUILD_COMPLEX16 +static struct DATA_ZAXPYC data_zaxpyc; + +/** + * Test zaxpyc by conjugating vector x and comparing with zaxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param incy - increment for the elements of y + * return norm of difference + */ +static double check_zaxpyc(blasint n, double *alpha, blasint incx, blasint incy) +{ + blasint i; + + drand_generate(data_zaxpyc.x_test, n * incx * 2); + drand_generate(data_zaxpyc.y_test, n * incy * 2); + + for (i = 0; i < n * incx * 2; i++) + data_zaxpyc.x_verify[i] = data_zaxpyc.x_test[i]; + + for (i = 0; i < n * incy * 2; i++) + data_zaxpyc.y_verify[i] = data_zaxpyc.y_test[i]; + + zconjugate_vector(n, incx, data_zaxpyc.x_verify); + + BLASFUNC(zaxpy) + (&n, alpha, data_zaxpyc.x_verify, &incx, + data_zaxpyc.y_verify, &incy); + + BLASFUNC(zaxpyc) + (&n, alpha, data_zaxpyc.x_test, &incx, + data_zaxpyc.y_test, &incy); + + for (i = 0; i < n * incy * 2; i++) + data_zaxpyc.y_verify[i] -= data_zaxpyc.y_test[i]; + + return BLASFUNC(dznrm2)(&n, data_zaxpyc.y_verify, &incy); +} + +/** + * Test zaxpyc by conjugating vector x and comparing with zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(zaxpyc, conj_strides_one) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {5.0, 2.2}; + + double norm = check_zaxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zaxpyc by conjugating vector x and comparing with zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(zaxpyc, conj_incx_one) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha[] = {5.0, 2.2}; + + double norm = check_zaxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zaxpyc by conjugating vector x and comparing with zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(zaxpyc, conj_incy_one) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha[] = {5.0, 2.2}; + + double norm = check_zaxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zaxpyc by conjugating vector x and comparing with zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(zaxpyc, conj_strides_two) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha[] = {5.0, 2.2}; + + double norm = check_zaxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif diff --git a/utest/test_extensions/test_zgbmv.c b/utest/test_extensions/test_zgbmv.c new file mode 100644 index 000000000..55473361c --- /dev/null +++ b/utest/test_extensions/test_zgbmv.c @@ -0,0 +1,280 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 1 + +struct DATA_ZGBMV { + double a_test[DATASIZE * DATASIZE * 2]; + double a_band_storage[DATASIZE * DATASIZE * 2]; + double matrix[DATASIZE * DATASIZE * 2]; + double b_test[DATASIZE * 2 * INCREMENT]; + double c_test[DATASIZE * 2 * INCREMENT]; + double c_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX16 + +static struct DATA_ZGBMV data_zgbmv; + +/** + * Transform full-storage band matrix A to band-packed storage mode. + * + * param m - number of rows of A + * param n - number of columns of A + * param kl - number of sub-diagonals of the matrix A + * param ku - number of super-diagonals of the matrix A + * output param a - buffer for holding band-packed matrix + * param lda - specifies the leading dimension of a + * param matrix - buffer holding full-storage band matrix A + * param ldm - specifies the leading full-storage band matrix A + */ +static void transform_to_band_storage(blasint m, blasint n, blasint kl, + blasint ku, double* a, blasint lda, + double* matrix, blasint ldm) +{ + blasint i, j, k; + for (j = 0; j < n; j++) + { + k = 2 * (ku - j); + for (i = MAX(0, 2*(j - ku)); i < MIN(m, j + kl + 1) * 2; i+=2) + { + a[(k + i) + j * lda * 2] = matrix[i + j * ldm * 2]; + a[(k + i) + j * lda * 2 + 1] = matrix[i + j * ldm * 2 + 1]; + } + } +} + +/** + * Generate full-storage band matrix A with kl sub-diagonals and ku super-diagonals + * + * param m - number of rows of A + * param n - number of columns of A + * param kl - number of sub-diagonals of the matrix A + * param ku - number of super-diagonals of the matrix A + * output param band_matrix - buffer for full-storage band matrix. + * param matrix - buffer holding input general matrix + * param ldm - specifies the leading of input general matrix + */ +static void get_band_matrix(blasint m, blasint n, blasint kl, blasint ku, + double *band_matrix, double *matrix, blasint ldm) +{ + blasint i, j; + blasint k = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < m * 2; j += 2) + { + if ((blasint)(j/2) > kl + i || i > ku + (blasint)(j/2)) + { + band_matrix[i * ldm * 2 + j] = 0.0; + band_matrix[i * ldm * 2 + j + 1] = 0.0; + continue; + } + + band_matrix[i * ldm * 2 + j] = matrix[k++]; + band_matrix[i * ldm * 2 + j + 1] = matrix[k++]; + } + } +} + +/** + * Comapare results computed by zgbmv and zgemv + * since gbmv is gemv for band matrix + * + * param trans specifies op(A), the transposition operation applied to A + * param m - number of rows of A + * param n - number of columns of A + * param kl - number of sub-diagonals of the matrix A + * param ku - number of super-diagonals of the matrix A + * param alpha - scaling factor for the matrix-vector product + * param lda - specifies the leading dimension of a + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param inc_c - stride of vector c + * return norm of differences + */ +static double check_zgbmv(char trans, blasint m, blasint n, blasint kl, blasint ku, + double *alpha, blasint lda, blasint inc_b, double *beta, blasint inc_c) +{ + blasint i; + blasint lenb, lenc; + + if(trans == 'T' || trans == 'C' || trans == 'D' || trans == 'U'){ + lenb = m; + lenc = n; + } else { + lenb = n; + lenc = m; + } + + drand_generate(data_zgbmv.matrix, m * n * 2); + drand_generate(data_zgbmv.b_test, 2 * (1 + (lenb - 1) * inc_b)); + drand_generate(data_zgbmv.c_test, 2 * (1 + (lenc - 1) * inc_c)); + + for (i = 0; i < 2 * (1 + (lenc - 1) * inc_c); i++) + data_zgbmv.c_verify[i] = data_zgbmv.c_test[i]; + + get_band_matrix(m, n, kl, ku, data_zgbmv.a_test, data_zgbmv.matrix, m); + + transform_to_band_storage(m, n, kl, ku, data_zgbmv.a_band_storage, lda, data_zgbmv.a_test, m); + + BLASFUNC(zgemv)(&trans, &m, &n, alpha, data_zgbmv.a_test, &m, data_zgbmv.b_test, + &inc_b, beta, data_zgbmv.c_verify, &inc_c); + + BLASFUNC(zgbmv)(&trans, &m, &n, &kl, &ku, alpha, data_zgbmv.a_band_storage, &lda, data_zgbmv.b_test, + &inc_b, beta, data_zgbmv.c_test, &inc_c); + + for (i = 0; i < 2 * (1 + (lenc - 1) * inc_c); i++) + data_zgbmv.c_verify[i] -= data_zgbmv.c_test[i]; + + return BLASFUNC(dznrm2)(&lenc, data_zgbmv.c_verify, &inc_c); +} + +/** + * Test zgbmv by comparing it against zgemv + * with param trans is D + */ +CTEST(zgbmv, trans_D) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 11; + blasint lda = 50; + char trans = 'D'; + + double alpha[] = {7.0, 1.0}; + double beta[] = {1.5, -1.5}; + + double norm = check_zgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgbmv by comparing it against zgemv + * with param trans is O + */ +CTEST(zgbmv, trans_O) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 10; + blasint lda = 50; + char trans = 'O'; + + double alpha[] = {7.0, 1.0}; + double beta[] = {1.5, -1.5}; + + double norm = check_zgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgbmv by comparing it against zgemv + * with param trans is S + */ +CTEST(zgbmv, trans_S) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 6, ku = 9; + blasint lda = 50; + char trans = 'S'; + + double alpha[] = {7.0, 1.0}; + double beta[] = {1.5, -1.5}; + + double norm = check_zgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgbmv by comparing it against zgemv + * with param trans is U + */ +CTEST(zgbmv, trans_U) +{ + blasint m = 25, n = 50; + blasint inc_b = 1, inc_c = 1; + blasint kl = 7, ku = 11; + blasint lda = kl + ku + 1; + char trans = 'U'; + + double alpha[] = {7.0, 1.0}; + double beta[] = {1.5, -1.5}; + + double norm = check_zgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgbmv by comparing it against zgemv + * with param trans is C + */ +CTEST(zgbmv, trans_C) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 11; + blasint lda = 50; + char trans = 'C'; + + double alpha[] = {7.0, 1.0}; + double beta[] = {1.5, -1.5}; + + double norm = check_zgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgbmv by comparing it against zgemv + * with param trans is R + */ +CTEST(zgbmv, trans_R) +{ + blasint m = 50, n = 100; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 11; + blasint lda = 50; + char trans = 'R'; + + double alpha[] = {7.0, 1.0}; + double beta[] = {1.5, -1.5}; + + double norm = check_zgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} +#endif diff --git a/utest/test_extensions/test_zgeadd.c b/utest/test_extensions/test_zgeadd.c new file mode 100644 index 000000000..917c04829 --- /dev/null +++ b/utest/test_extensions/test_zgeadd.c @@ -0,0 +1,880 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define N 100 +#define M 100 + +struct DATA_ZGEADD { + double a_test[M * N * 2]; + double c_test[M * N * 2]; + double c_verify[M * N * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZGEADD data_zgeadd; + +/** + * zgeadd reference implementation + * + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param aptr - refer to matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param cptr - refer to matrix C + * param ldc - leading dimension of C + */ +static void zgeadd_trusted(blasint m, blasint n, double *alpha, double *aptr, + blasint lda, double *beta, double *cptr, blasint ldc) +{ + blasint i; + + lda *= 2; + ldc *= 2; + + for (i = 0; i < n; i++) + { + cblas_zaxpby(m, alpha, aptr, 1, beta, cptr, 1); + aptr += lda; + cptr += ldc; + } +} + +/** + * Test zgeadd by comparing it against reference + * Compare with the following options: + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static double check_zgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, double *alpha, blasint lda, + double *beta, blasint ldc) +{ + blasint i; + blasint cols = m, rows = n; + + if (order == CblasRowMajor) + { + rows = m; + cols = n; + } + + // Fill matrix A, C + srand_generate(data_zgeadd.a_test, lda * rows * 2); + srand_generate(data_zgeadd.c_test, ldc * rows * 2); + + // Copy matrix C for zgeadd + for (i = 0; i < ldc * rows * 2; i++) + data_zgeadd.c_verify[i] = data_zgeadd.c_test[i]; + + zgeadd_trusted(cols, rows, alpha, data_zgeadd.a_test, lda, + beta, data_zgeadd.c_verify, ldc); + + if (api == 'F') + BLASFUNC(zgeadd)(&m, &n, alpha, data_zgeadd.a_test, &lda, + beta, data_zgeadd.c_test, &ldc); + else + cblas_zgeadd(order, m, n, alpha, data_zgeadd.a_test, lda, + beta, data_zgeadd.c_test, ldc); + + // Find the differences between output matrix caculated by zgeadd and sgemm + return dmatrix_difference(data_zgeadd.c_test, data_zgeadd.c_verify, cols, rows, ldc * 2); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param lda - leading dimension of A + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in zgeadd + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, blasint lda, + blasint ldc, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + set_xerbla("ZGEADD ", expected_info); + + if (api == 'F') + BLASFUNC(zgeadd)(&m, &n, alpha, data_zgeadd.a_test, &lda, + beta, data_zgeadd.c_test, &ldc); + else + cblas_zgeadd(order, m, n, alpha, data_zgeadd.a_test, lda, + beta, data_zgeadd.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(zgeadd, matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {3.0, 2.0}; + double beta[] = {1.0, 3.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(zgeadd, matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {0.0, 0.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(zgeadd, matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {3.0, 1.5}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(zgeadd, matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {0.0, 0.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(zgeadd, matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param n - + * number of columns of A and C + * Must be at least zero. + */ +CTEST(zgeadd, xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = m; + blasint ldc = m; + + int expected_info = 2; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + */ +CTEST(zgeadd, xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + */ +CTEST(zgeadd, xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 6; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + */ +CTEST(zgeadd, xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Check if n - number of columns of A, C equal zero. + */ +CTEST(zgeadd, n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Check if m - number of rows of A and C equal zero. + */ +CTEST(zgeadd, m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(zgeadd, c_api_matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 3.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(zgeadd, c_api_matrix_n_100_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {4.0, 1.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(zgeadd, c_api_matrix_n_50_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N / 2; + blasint m = M; + + blasint lda = n; + blasint ldc = n; + + double alpha[] = {3.0, 2.5}; + double beta[] = {1.0, 2.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(zgeadd, c_api_matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {0.0, 0.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(zgeadd, c_api_matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {3.0, 1.5}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(zgeadd, c_api_matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {0.0, 0.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(zgeadd, c_api_matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {2.0, 3.0}; + double beta[] = {2.0, 4.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test error function for an invalid param order - + * specifies whether A and C stored in + * row-major order or column-major order + */ +CTEST(zgeadd, c_api_xerbla_invalid_order) +{ + CBLAS_ORDER order = INVALID; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 0; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(zgeadd, c_api_xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(zgeadd, c_api_xerbla_n_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(zgeadd, c_api_xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(zgeadd, c_api_xerbla_m_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(zgeadd, c_api_xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(zgeadd, c_api_xerbla_lda_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(zgeadd, c_api_xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(zgeadd, c_api_xerbla_ldc_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Check if n - number of columns of A, C equal zero. + * + * c api option order is column-major order + */ +CTEST(zgeadd, c_api_n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Check if m - number of rows of A and C equal zero. + * + * c api option order is column-major order + */ +CTEST(zgeadd, c_api_m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zgemm.c b/utest/test_extensions/test_zgemm.c new file mode 100644 index 000000000..4160a5086 --- /dev/null +++ b/utest/test_extensions/test_zgemm.c @@ -0,0 +1,273 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZGEMM { + double a_test[DATASIZE * DATASIZE * 2]; + double a_verify[DATASIZE * DATASIZE * 2]; + double b_test[DATASIZE * DATASIZE * 2]; + double b_verify[DATASIZE * DATASIZE * 2]; + double c_test[DATASIZE * DATASIZE * 2]; + double c_verify[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZGEMM data_zgemm; + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * + * param transa specifies op(A), the transposition (conjugation) operation applied to A + * param transb specifies op(B), the transposition (conjugation) operation applied to B + * param m specifies the number of rows of the matrix op(A) and of the matrix C + * param n specifies the number of columns of the matrix op(B) and the number of columns of the matrix C + * param k specifies the number of columns of the matrix op(A) and the number of rows of the matrix op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of matrix A + * param ldb - leading dimension of matrix B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of matrix C + * return norm of difference + */ +static double check_zgemm(char transa, char transb, blasint m, blasint n, blasint k, + double *alpha, blasint lda, blasint ldb, double *beta, blasint ldc) +{ + blasint i; + double alpha_conj[] = {1.0, 0.0}; + char transa_verify = transa; + char transb_verify = transb; + + int arows = k, acols = m; + int brows = n, bcols = k; + + if (transa == 'T' || transa == 'C'){ + arows = m; acols = k; + } + + if (transb == 'T' || transb == 'C'){ + brows = k; bcols = n; + } + + drand_generate(data_zgemm.a_test, arows * lda * 2); + drand_generate(data_zgemm.b_test, brows * ldb * 2); + drand_generate(data_zgemm.c_test, n * ldc * 2); + + for (i = 0; i < arows * lda * 2; i++) + data_zgemm.a_verify[i] = data_zgemm.a_test[i]; + + for (i = 0; i < brows * ldb * 2; i++) + data_zgemm.b_verify[i] = data_zgemm.b_test[i]; + + for (i = 0; i < n * ldc * 2; i++) + data_zgemm.c_verify[i] = data_zgemm.c_test[i]; + + if (transa == 'R'){ + cblas_zimatcopy(CblasColMajor, CblasConjNoTrans, arows, acols, alpha_conj, data_zgemm.a_verify, lda, lda); + transa_verify = 'N'; + } + + if (transb == 'R'){ + cblas_zimatcopy(CblasColMajor, CblasConjNoTrans, brows, bcols, alpha_conj, data_zgemm.b_verify, ldb, ldb); + transb_verify = 'N'; + } + + BLASFUNC(zgemm)(&transa_verify, &transb_verify, &m, &n, &k, alpha, data_zgemm.a_verify, &lda, + data_zgemm.b_verify, &ldb, beta, data_zgemm.c_verify, &ldc); + + BLASFUNC(zgemm)(&transa, &transb, &m, &n, &k, alpha, data_zgemm.a_test, &lda, + data_zgemm.b_test, &ldb, beta, data_zgemm.c_test, &ldc); + + return dmatrix_difference(data_zgemm.c_test, data_zgemm.c_verify, m, n, ldc*2); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is conjugate and transposed + * matrix B is conjugate and not transposed + */ +CTEST(zgemm, conjtransa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'C'; + char transb = 'R'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is not conjugate and not transposed + * matrix B is conjugate and not transposed + */ +CTEST(zgemm, notransa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'N'; + char transb = 'R'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is conjugate and transposed + */ +CTEST(zgemm, conjnotransa_conjtransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'C'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is not conjugate and not transposed + */ +CTEST(zgemm, conjnotransa_notransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'N'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is conjugate and not transposed + */ +CTEST(zgemm, conjnotransa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'R'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is transposed + */ +CTEST(zgemm, conjnotransa_transb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'T'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is transposed + * matrix B is conjugate and not transposed + */ +CTEST(zgemm, transa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'T'; + char transb = 'R'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zgemmt.c b/utest/test_extensions/test_zgemmt.c new file mode 100644 index 000000000..c55381008 --- /dev/null +++ b/utest/test_extensions/test_zgemmt.c @@ -0,0 +1,2010 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_ZGEMMT { + double a_test[DATASIZE * DATASIZE * 2]; + double b_test[DATASIZE * DATASIZE * 2]; + double c_test[DATASIZE * DATASIZE * 2]; + double c_verify[DATASIZE * DATASIZE * 2]; + double c_gemm[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZGEMMT data_zgemmt; + +/** + * Compute gemmt via gemm since gemmt is gemm but updates only + * the upper or lower triangular part of the result matrix + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + */ +static void zgemmt_trusted(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, double *alpha, blasint lda, + blasint ldb, double *beta, blasint ldc) +{ + blasint i, j; + + if(api == 'F') + BLASFUNC(zgemm)(&transa, &transb, &m, &m, &k, alpha, data_zgemmt.a_test, &lda, + data_zgemmt.b_test, &ldb, beta, data_zgemmt.c_gemm, &ldc); + else + cblas_zgemm(order, transa, transb, m, m, k, alpha, data_zgemmt.a_test, lda, + data_zgemmt.b_test, ldb, beta, data_zgemmt.c_gemm, ldc); + + ldc *= 2; + + if (uplo == 'L' || uplo == CblasLower) + { + for (i = 0; i < m; i++) + for (j = i * 2; j < m * 2; j+=2){ + data_zgemmt.c_verify[i * ldc + j] = + data_zgemmt.c_gemm[i * ldc + j]; + data_zgemmt.c_verify[i * ldc + j + 1] = + data_zgemmt.c_gemm[i * ldc + j + 1]; + } + } else { + for (i = 0; i < m; i++) + for (j = 0; j <= i * 2; j+=2){ + data_zgemmt.c_verify[i * ldc + j] = + data_zgemmt.c_gemm[i * ldc + j]; + data_zgemmt.c_verify[i * ldc + j + 1] = + data_zgemmt.c_gemm[i * ldc + j + 1]; + } + } +} + +/** + * Comapare results computed by zgemmt and zgemmt_trusted + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static double check_zgemmt(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, double *alpha, blasint lda, + blasint ldb, double *beta, blasint ldc) +{ + blasint i; + blasint b_cols; + blasint a_cols; + blasint inc = 1; + blasint size_c = m * ldc * 2; + + if(order == CblasColMajor){ + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = m; + else a_cols = k; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = k; + else b_cols = m; + } else { + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = k; + else a_cols = m; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = m; + else b_cols = k; + } + + drand_generate(data_zgemmt.a_test, a_cols * lda * 2); + drand_generate(data_zgemmt.b_test, b_cols * ldb * 2); + drand_generate(data_zgemmt.c_test, m * ldc * 2); + + for (i = 0; i < m * ldc * 2; i++) + data_zgemmt.c_gemm[i] = data_zgemmt.c_verify[i] = data_zgemmt.c_test[i]; + + zgemmt_trusted(api, order, uplo, transa, transb, m, k, alpha, lda, ldb, beta, ldc); + + if (api == 'F') + BLASFUNC(zgemmt)(&uplo, &transa, &transb, &m, &k, alpha, data_zgemmt.a_test, + &lda, data_zgemmt.b_test, &ldb, beta, data_zgemmt.c_test, &ldc); + else + cblas_zgemmt(order, uplo, transa, transb, m, k, alpha, data_zgemmt.a_test, lda, + data_zgemmt.b_test, ldb, beta, data_zgemmt.c_test, ldc); + + for (i = 0; i < m * ldc * 2; i++) + data_zgemmt.c_verify[i] -= data_zgemmt.c_test[i]; + + return BLASFUNC(dnrm2)(&size_c, data_zgemmt.c_verify, &inc) / size_c; +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in zgemmt + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, blasint lda, blasint ldb, + blasint ldc, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + set_xerbla("ZGEMMT ", expected_info); + + if (api == 'F') + BLASFUNC(zgemmt)(&uplo, &transa, &transb, &m, &k, alpha, data_zgemmt.a_test, + &lda, data_zgemmt.b_test, &ldb, beta, data_zgemmt.c_test, &ldc); + else + cblas_zgemmt(order, uplo, transa, transb, m, k, alpha, data_zgemmt.a_test, lda, + data_zgemmt.b_test, ldb, beta, data_zgemmt.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(zgemmt, upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(zgemmt, upper_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(zgemmt, upper_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + char transa = 'N', transb = 'T'; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(zgemmt, upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'U'; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(zgemmt, upper_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + char transa = 'R', transb = 'R'; + char uplo = 'U'; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(zgemmt, upper_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'R'; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(zgemmt, upper_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'R', transb = 'C'; + char uplo = 'U'; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(zgemmt, upper_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'C'; + char uplo = 'U'; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(zgemmt, upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + double alpha[] = {0.0, 0.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(zgemmt, upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(zgemmt, lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(zgemmt, lower_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'L'; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(zgemmt, lower_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + char transa = 'N', transb = 'T'; + char uplo = 'L'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(zgemmt, lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'L'; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(zgemmt, lower_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + char transa = 'R', transb = 'R'; + char uplo = 'L'; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(zgemmt, lower_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'R'; + char uplo = 'L'; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(zgemmt, lower_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'R', transb = 'C'; + char uplo = 'L'; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(zgemmt, lower_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'C'; + char uplo = 'L'; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(zgemmt, lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + double alpha[] = {0.0, 0.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(zgemmt, lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(zgemmt, c_api_colmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {0.0, 0.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(zgemmt, c_api_colmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(zgemmt, c_api_colmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {0.0, 0.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(zgemmt, c_api_colmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 50, ldc = 25; + double alpha[] = {1.0, 1.0}; + double beta[] = {-1.0, -1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 25, ldc = 25; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_25_K_50_a_conjtrans_b_conjtrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(zgemmt, c_api_rowmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {0.0, 0.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(zgemmt, c_api_rowmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 50, ldc = 25; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 25, ldc = 25; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 25, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(zgemmt, c_api_rowmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {0.0, 0.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(zgemmt, c_api_rowmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param uplo. + * Must be upper (U) or lower (L). + */ +CTEST(zgemmt, xerbla_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'O'; + int expected_info = 1; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transa. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(zgemmt, xerbla_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'O', transb = 'N'; + char uplo = 'U'; + int expected_info = 2; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transb. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(zgemmt, xerbla_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'O'; + char uplo = 'U'; + int expected_info = 3; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(zgemmt, xerbla_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 4; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(zgemmt, xerbla_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 5; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(zgemmt, xerbla_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 8; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(zgemmt, xerbla_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 10; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(zgemmt, xerbla_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 13; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. + * Test error function for an invalid param order. + * Must be column or row major. + */ +CTEST(zgemmt, xerbla_c_api_major_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 0; + + int passed = check_badargs('C', 'O', CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasColMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasRowMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B transposed. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zgemv_n.c b/utest/test_extensions/test_zgemv_n.c new file mode 100644 index 000000000..903b855e1 --- /dev/null +++ b/utest/test_extensions/test_zgemv_n.c @@ -0,0 +1,341 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZSPMV_N { + double a_test[DATASIZE * DATASIZE * 2]; + double b_test[DATASIZE * 2 * INCREMENT]; + double c_test[DATASIZE * 2 * INCREMENT]; + double c_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX16 + +static struct DATA_ZSPMV_N data_zgemv_n; + +/** + * zgemv not transposed reference code + * + * param trans specifies whether matris A is conj or/and xconj + * param m - number of rows of A + * param n - number of columns of A + * param alpha - scaling factor for the matrib-vector product + * param a - buffer holding input matrib A + * param lda - leading dimension of matrix A + * param b - Buffer holding input vector b + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param c - buffer holding input/output vector c + * param inc_c - stride of vector c + */ +static void zgemv_n_trusted(char trans, blasint m, blasint n, double *alpha, double *a, + blasint lda, double *b, blasint inc_b, double *beta, double *c, + blasint inc_c) +{ + blasint i, j; + blasint i2 = 0; + blasint ib = 0, ic = 0; + + double temp_r, temp_i; + + double *a_ptr = a; + blasint lda2 = 2*lda; + + blasint inc_b2 = 2 * inc_b; + blasint inc_c2 = 2 * inc_c; + + BLASFUNC(zscal)(&m, beta, c, &inc_c); + + for (j = 0; j < n; j++) + { + + if (trans == 'N' || trans == 'R') { + temp_r = alpha[0] * b[ib] - alpha[1] * b[ib+1]; + temp_i = alpha[0] * b[ib+1] + alpha[1] * b[ib]; + } else { + temp_r = alpha[0] * b[ib] + alpha[1] * b[ib+1]; + temp_i = alpha[0] * b[ib+1] - alpha[1] * b[ib]; + } + + ic = 0; + i2 = 0; + + for (i = 0; i < m; i++) + { + if (trans == 'N') { + c[ic] += temp_r * a_ptr[i2] - temp_i * a_ptr[i2+1]; + c[ic+1] += temp_r * a_ptr[i2+1] + temp_i * a_ptr[i2]; + } + if (trans == 'O') { + c[ic] += temp_r * a_ptr[i2] + temp_i * a_ptr[i2+1]; + c[ic+1] += temp_r * a_ptr[i2+1] - temp_i * a_ptr[i2]; + } + if (trans == 'R') { + c[ic] += temp_r * a_ptr[i2] + temp_i * a_ptr[i2+1]; + c[ic+1] -= temp_r * a_ptr[i2+1] - temp_i * a_ptr[i2]; + } + if (trans == 'S') { + c[ic] += temp_r * a_ptr[i2] - temp_i * a_ptr[i2+1]; + c[ic+1] -= temp_r * a_ptr[i2+1] + temp_i * a_ptr[i2]; + } + i2 += 2; + ic += inc_c2; + } + a_ptr += lda2; + ib += inc_b2; + } + +} + +/** + * Comapare results computed by zgemv and zgemv_n_trusted + * + * param trans specifies whether matris A is conj or/and xconj + * param m - number of rows of A + * param n - number of columns of A + * param alpha - scaling factor for the matrib-vector product + * param lda - leading dimension of matrix A + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param inc_c - stride of vector c + * return norm of differences + */ +static double check_zgemv_n(char trans, blasint m, blasint n, double *alpha, blasint lda, + blasint inc_b, double *beta, blasint inc_c) +{ + blasint i; + + drand_generate(data_zgemv_n.a_test, n * lda); + drand_generate(data_zgemv_n.b_test, 2 * n * inc_b); + drand_generate(data_zgemv_n.c_test, 2 * m * inc_c); + + for (i = 0; i < m * 2 * inc_c; i++) + data_zgemv_n.c_verify[i] = data_zgemv_n.c_test[i]; + + zgemv_n_trusted(trans, m, n, alpha, data_zgemv_n.a_test, lda, data_zgemv_n.b_test, + inc_b, beta, data_zgemv_n.c_test, inc_c); + BLASFUNC(zgemv)(&trans, &m, &n, alpha, data_zgemv_n.a_test, &lda, data_zgemv_n.b_test, + &inc_b, beta, data_zgemv_n.c_verify, &inc_c); + + for (i = 0; i < m * 2 * inc_c; i++) + data_zgemv_n.c_verify[i] -= data_zgemv_n.c_test[i]; + + return BLASFUNC(dznrm2)(&n, data_zgemv_n.c_verify, &inc_c); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zgemv, trans_o_square_matrix) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'O'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.4, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows of A is 50 + * Number of colums of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zgemv, trans_o_rectangular_matrix_rows_less_then_cols) +{ + blasint n = 100, m = 50, lda = 50; + blasint inc_b = 1, inc_c = 1; + char trans = 'O'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.4, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows of A is 100 + * Number of colums of A is 50 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zgemv, trans_o_rectangular_matrix_cols_less_then_rows) +{ + blasint n = 50, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'O'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.4, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(zgemv, trans_o_double_strides) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 2, inc_c = 2; + char trans = 'O'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.4, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zgemv, trans_s_square_matrix) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'S'; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.4, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows of A is 50 + * Number of colums of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zgemv, trans_s_rectangular_matrix_rows_less_then_cols) +{ + blasint n = 100, m = 50, lda = 50; + blasint inc_b = 1, inc_c = 1; + char trans = 'S'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.4, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows of A is 100 + * Number of colums of A is 50 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zgemv, trans_s_rectangular_matrix_cols_less_then_rows) +{ + blasint n = 50, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'S'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.4, 0.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(zgemv, trans_s_double_strides) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 2, inc_c = 2; + char trans = 'S'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.0, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +#endif diff --git a/utest/test_extensions/test_zgemv_t.c b/utest/test_extensions/test_zgemv_t.c new file mode 100644 index 000000000..2e0ee65f0 --- /dev/null +++ b/utest/test_extensions/test_zgemv_t.c @@ -0,0 +1,1136 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define N 100 +#define M 100 +#define INCREMENT 2 + +struct DATA_ZGEMV_T { + double a_test[N * M * 2]; + double a_verify[N * M * 2]; + double y_test[M * INCREMENT * 2]; + double y_verify[M * INCREMENT * 2]; + double x_test[M * INCREMENT * 2]; + double x_verify[M * INCREMENT * 2]; +}; + +// DOUBLE_EPS_ZGEMV = MAX_VAL * NUMBER OF OPERATIONS * DBL_EPSILON +// DOUBLE_EPS_ZGEMV = 5.0 * O(100 * 100) * 2.2e-16 = 1e-11 +#define DOUBLE_EPS_ZGEMV 1e-11 + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZGEMV_T data_zgemv_t; + +/** + * Find product of matrix-vector multiplication + * + * param n specifies number of columns of A + * param m specifies number of rows of A and size of vector x + * param lda specifies leading dimension of A + * param inc_x specifies increment of vector x + */ +static void matrix_vector_product(blasint n, blasint m, blasint lda, blasint inc_x) +{ + blasint i; + double *a_ptr = data_zgemv_t.a_verify; + double *x_ptr = data_zgemv_t.x_test; + double *x_res = data_zgemv_t.x_verify; + + openblas_complex_double result; + + for (i = 0; i < n * inc_x; i += inc_x) + { + result = cblas_zdotu(lda, a_ptr, 1, x_ptr, inc_x); + x_res[0] = CREAL(result); + x_res[1] = CIMAG(result); + a_ptr += lda * 2; + x_res += 2 * inc_x; + } +} + +/** + * Test zgemv by comparing it against zomatcopy, zaxpby and + * reference func matrix_vector_product + * + * zomatcopy perform operation: op(A) + * matrix_vector_product perform operation: A*x + * zaxpby perform operation: alpha*x + beta*y + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param m specifies number of rows of A + * param n specifies number of columns of A + * param alpha specifies scalar alpha + * param lda specifies leading dimension of the matrix A + * param inc_x specifies increment for vector x + * param beta specifies scalar beta + * param inc_y specifies increment for vector y + * return norm of difference between zgemv and result of reference funcs + */ +static double check_zgemv(char api, char order, char trans, blasint m, blasint n, double *alpha, + blasint lda, blasint inc_x, double *beta, blasint inc_y) +{ + blasint i; + + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + + // Transpose parameters for zomatcopy + // zgemv_t perform operation on transposed matrix, no need to transpose a_verify + char trans_copy; + char ctrans_copy; + + // Param alpha for zomatcopy, scale on alpha perform zaxpby + double alpha_one[] = {1.0, 0.0}; + + memset(data_zgemv_t.x_verify, 0.0, m * inc_x * 2 * sizeof(double)); + + // Fill matrix A, vectors x, y + drand_generate(data_zgemv_t.a_test, lda * n * 2); + drand_generate(data_zgemv_t.x_test, m * inc_x * 2); + drand_generate(data_zgemv_t.y_test, m * inc_y * 2); + + // Copy vector y for reference funcs + for (int i = 0; i < m * inc_y * 2; i++) + { + data_zgemv_t.y_verify[i] = data_zgemv_t.y_test[i]; + } + + if (api == 'F') { + if (trans == 'T') trans_copy = 'N'; + if (trans == 'C') trans_copy = 'R'; + if (trans == 'U') trans_copy = 'R'; + if (trans == 'D') trans_copy = 'N'; + + // Perform operation: op(A) + BLASFUNC(zomatcopy)(&order, &trans_copy, &m, &n, alpha_one, + data_zgemv_t.a_test, &lda, data_zgemv_t.a_verify, &lda); + + // Find A*x + matrix_vector_product(n, m, lda, inc_x); + + // Find conj(x) + if (trans == 'U' || trans == 'D') + { + zconjugate_vector(m, inc_x, data_zgemv_t.x_verify); + } + + // Find alpha*x+beta*y + BLASFUNC(zaxpby)(&n, alpha, data_zgemv_t.x_verify, &inc_x, beta, + data_zgemv_t.y_verify, &inc_y); + + BLASFUNC(zgemv)(&trans, &m, &n, alpha, data_zgemv_t.a_test, &lda, + data_zgemv_t.x_test, &inc_x, beta, data_zgemv_t.y_test, &inc_y); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') {ctrans = CblasTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasTrans : CblasNoTrans;} + if (trans == 'N') {ctrans = CblasNoTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasNoTrans : CblasTrans;} + if (trans == 'C') {ctrans = CblasConjTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasConjTrans : CblasConjNoTrans;} + if (trans == 'R') {ctrans = CblasConjNoTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasConjNoTrans : CblasConjTrans;} + + // Perform operation: op(A) + cblas_zomatcopy(corder, ctrans_copy, m, n, alpha_one, data_zgemv_t.a_test, lda, data_zgemv_t.a_verify, lda); + + // Find A*x + matrix_vector_product(n, m, lda, inc_x); + + // Find alpha*x+beta*y + cblas_zaxpby(n, alpha, data_zgemv_t.x_verify, inc_x, beta, data_zgemv_t.y_verify, inc_y); + + cblas_zgemv(corder, ctrans, m, n, alpha, data_zgemv_t.a_test, + lda, data_zgemv_t.x_test, inc_x, beta, data_zgemv_t.y_test, inc_y); + } + + // Find the differences between output vector caculated by zgemv and reference funcs + for (i = 0; i < m * inc_y * 2; i++) + data_zgemv_t.y_test[i] -= data_zgemv_t.y_verify[i]; + + // Find the norm of differences + return cblas_dznrm2(m, data_zgemv_t.y_test, inc_y); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param m specifies number of rows of A + * param n specifies number of columns of A + * param lda specifies leading dimension of the matrix A + * param inc_x specifies increment for vector x + * param inc_y specifies increment for vector y + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint m, blasint n, + blasint lda, blasint inc_x, blasint inc_y, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + double a[] = {1.0, 1.0}; + double x[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + double y[] = {1.0, 1.0}; + + set_xerbla("ZGEMV ", expected_info); + + BLASFUNC(zgemv)(&trans, &m, &n, alpha, a, &lda, x, + &inc_x, beta, y, &inc_y); + + return check_error(); +} + +/** + * C API specific function + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param m specifies number of rows of A + * param n specifies number of columns of A + * param lda specifies leading dimension of the matrix A + * param inc_x specifies increment for vector x + * param inc_y specifies increment for vector y + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int c_api_check_badargs(CBLAS_ORDER corder, CBLAS_TRANSPOSE ctrans, blasint m, blasint n, + blasint lda, blasint inc_x, blasint inc_y, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + double a[] = {1.0, 1.0}; + double x[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + double y[] = {1.0, 1.0}; + + set_xerbla("ZGEMV ", expected_info); + + cblas_zgemv(corder, ctrans, m, n, alpha, a, lda, x, inc_x, beta, y, inc_y); + + return check_error(); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0, alpha_i = 1.0 + * beta_r = 2.0, beta_i = 2.0 + */ +CTEST(zgemv, colmajor_trans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'T'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 2.0}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0, alpha_i = 1.0 + * beta_r = 2.0, beta_i = 2.0 + */ +CTEST(zgemv, colmajor_trans_col_100_row_100_inc_x_2_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'T'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 2.0}; + + blasint inc_x = 2; + blasint inc_y = 1; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 2.0, alpha_i = 1.0 + * beta_r = 2.0, beta_i = 1.0 + */ +CTEST(zgemv, colmajor_conjtrans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {2.0, 1.0}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 1, inc y = 2 + * alpha_r = 2.0, alpha_i = 1.0 + * beta_r = 2.0, beta_i = 1.0 + */ +CTEST(zgemv, colmajor_conjtrans_col_100_row_100_inc_x_1_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + blasint inc_x = 1; + blasint inc_y = 2; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and x conjugate + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 2.0, alpha_i = 1.0 + * beta_r = 2.0, beta_i = 1.0 + */ +CTEST(zgemv, colmajor_trans_x_conj_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'U'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and x conjugate + * Square matrix + * inc x = 2, inc y = 2 + * alpha_r = 1.0, alpha_i = 2.0 + * beta_r = 1.0, beta_i = 1.0 + */ +CTEST(zgemv, colmajor_trans_x_conj_col_100_row_100_inc_x_2_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'U'; + + double alpha[] = {1.0, 2.0}; + double beta[] = {1.0, 1.0}; + + blasint inc_x = 2; + blasint inc_y = 2; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition, conjugate A, conjugate x + * Square matrix + * inc x = 2, inc y = 2 + * alpha_r = 2.0, alpha_i = 1.0 + * beta_r = 1.0, beta_i = 2.0 + */ +CTEST(zgemv, colmajor_conjtrans_x_conj_col_100_row_100_inc_x_1_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'D'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 2.0}; + + blasint inc_x = 1; + blasint inc_y = 2; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition, conjugate A, conjugate x + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 2.0, alpha_i = 1.0 + * beta_r = 1.0, beta_i = 2.0 + */ +CTEST(zgemv, c_api_colmajor_trans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'T'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 2.0}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0, alpha_i = 1.0 + * beta_r = 1.0, beta_i = 2.0 + */ +CTEST(zgemv, c_api_colmajor_conjtrans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 2.0}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 1, inc y = 2 + * alpha_r = 1.0, alpha_i = 1.0 + * beta_r = 1.0, beta_i = 2.0 + */ +CTEST(zgemv, c_api_colmajor_conjtrans_col_100_row_100_inc_x_1_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 2.0}; + + blasint inc_x = 1; + blasint inc_y = 2; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Row Major + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 2.0, alpha_i = 1.0 + * beta_r = 1.0, beta_i = 1.0 + */ +CTEST(zgemv, c_api_rowmajor_notrans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'N'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 1.0}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Row Major + * No trans + * Square matrix + * inc x = 2, inc y = 2 + * alpha_r = 1.0, alpha_i = 1.0 + * beta_r = 3.0, beta_i = 2.0 + */ +CTEST(zgemv, c_api_rowmajor_notrans_col_100_row_100_inc_x_2_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'N'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {3.0, 1.0}; + + blasint inc_x = 2; + blasint inc_y = 2; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Conjugate + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 1.0, alpha_i = 3.0 + * beta_r = 1.0, beta_i = 2.5 + */ +CTEST(zgemv, c_api_rowmajor_conj_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'R'; + + double alpha[] = {1.0, 3.0}; + double beta[] = {1.0, 2.5}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Row Major + * Conjugate + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0, alpha_i = 1.0 + * beta_r = 1.0, beta_i = 1.5 + */ +CTEST(zgemv, c_api_rowmajor_conj_col_100_row_100_inc_x_2_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'R'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.5}; + + blasint inc_x = 2; + blasint inc_y = 1; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test error function for an invalid param inc_y. + * Must be positive + * + * Column major + */ +CTEST(zgemv, xerbla_invalid_inc_y) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 0; + + int expected_info = 11; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_y. + * Must be positive + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_inc_y_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 0; + + int expected_info = 11; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_y. + * Must be positive + * + * Row major + */ +CTEST(zgemv, c_api_xerbla_invalid_inc_y_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 0; + + int expected_info = 11; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param inc_x. + * Must be positive + * + * Column major + */ +CTEST(zgemv, xerbla_invalid_inc_x) +{ + char order = 'C'; + char trans = 'T'; + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 0; + blasint inc_y = 1; + + int expected_info = 8; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_x. + * Must be positive + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_inc_x_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 0; + blasint inc_y = 1; + + int expected_info = 8; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_x. + * Must be positive + * + * Row major + */ +CTEST(zgemv, c_api_xerbla_invalid_inc_x_row_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 0; + blasint inc_y = 1; + + int expected_info = 8; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param n. + * Must be positive. + * + * Column major + */ +CTEST(zgemv, xerbla_invalid_n) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = 1, n = INVALID; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n. + * Must be positive. + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_n_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = INVALID; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 3; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n. + * Must be positive. + * + * Row major + */ +CTEST(zgemv, c_api_xerbla_invalid_n_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = INVALID, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 3; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param m. + * Must be positive. + * + * Column major + */ +CTEST(zgemv, xerbla_invalid_m) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = INVALID, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m. + * Must be positive. + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_m_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = INVALID, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 2; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m. + * Must be positive. + * + * Row major + */ +CTEST(zgemv, c_api_xerbla_invalid_m_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = 1, n = INVALID; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 2; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda. + * lda must be at least n. + * + * Column major + */ +CTEST(zgemv, xerbla_invalid_lda) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = 1, n = 1; + blasint lda = INVALID; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 6; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda. + * If matrices are stored using col major layout, + * lda must be at least m. + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_lda_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = INVALID; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 6; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda. + * If matrices are stored using col major layout, + * lda must be at least n. + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_lda_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = 1, n = 1; + blasint lda = INVALID; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 6; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param trans. + * + * Column major + */ +CTEST(zgemv, xerbla_invalid_trans) +{ + char order = 'C'; + char trans = 'Z'; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param trans. + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_trans_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = INVALID; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 1; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param trans. + * + * Row major + */ +CTEST(zgemv, c_api_xerbla_invalid_trans_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = INVALID; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 1; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param order. + */ +CTEST(zgemv, c_api_xerbla_invalid_order_col_major) +{ + enum CBLAS_ORDER corder = INVALID; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 0; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zimatcopy.c b/utest/test_extensions/test_zimatcopy.c new file mode 100644 index 000000000..6461ce88f --- /dev/null +++ b/utest/test_extensions/test_zimatcopy.c @@ -0,0 +1,850 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_ZIMATCOPY { + double a_test[DATASIZE * DATASIZE * 2]; + double a_verify[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZIMATCOPY data_zimatcopy; + +/** + * Comapare results computed by zimatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param alpha specifies scaling factor for matrix A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * return norm of difference between openblas and reference func + */ +static double check_zimatcopy(char api, char order, char trans, blasint rows, blasint cols, double *alpha, + blasint lda_src, blasint lda_dst) +{ + blasint m, n; + blasint rows_out, cols_out; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + int conj = -1; + + if (order == 'C') { + n = rows; m = cols; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + rows_out = n; cols_out = m*2; + if (trans == 'C') + conj = 1; + } + else { + rows_out = m; cols_out = n*2; + if (trans == 'R') + conj = 1; + } + + drand_generate(data_zimatcopy.a_test, lda_src*m*2); + + if (trans == 'T' || trans == 'C') { + ztranspose(m, n, alpha, data_zimatcopy.a_test, lda_src, data_zimatcopy.a_verify, lda_dst, conj); + } + else { + zcopy(m, n, alpha, data_zimatcopy.a_test, lda_src, data_zimatcopy.a_verify, lda_dst, conj); + } + + if (api == 'F') { + BLASFUNC(zimatcopy)(&order, &trans, &rows, &cols, alpha, data_zimatcopy.a_test, + &lda_src, &lda_dst); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_zimatcopy(corder, ctrans, rows, cols, alpha, data_zimatcopy.a_test, + lda_src, lda_dst); + } + + // Find the differences between output matrix computed by zimatcopy and reference func + return dmatrix_difference(data_zimatcopy.a_test, data_zimatcopy.a_verify, cols_out, rows_out, lda_dst*2); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda_src, blasint lda_dst, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + + set_xerbla("ZIMATCOPY", expected_info); + + BLASFUNC(zimatcopy)(&order, &trans, &rows, &cols, alpha, data_zimatcopy.a_test, + &lda_src, &lda_dst); + + return check_error(); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha_r = -3.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha[] = {-3.0, 1.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'R'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, colmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'C'; + double alpha[] = {2.0, 1.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, colmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 50; + char order = 'C'; + char trans = 'N'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, colmajor_conjtrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'C'; + double alpha[] = {1.0, 1.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, colmajor_conj_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 50; + char order = 'C'; + char trans = 'R'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha_r = 2.0, alpha_i = 3.0 + */ +CTEST(zimatcopy, rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha[] = {2.0, 3.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'R'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'C'; + double alpha[] = {2.0, 1.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 50; + char order = 'R'; + char trans = 'N'; + double alpha[] = {2.0, 1.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, rowmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zimatcopy, rowmajor_conj_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 50; + char order = 'R'; + char trans = 'R'; + double alpha[] = {1.5, -1.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, rowmajor_conjtrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'C'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha_r = 3.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, c_api_colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + double alpha[] = {3.0, 2.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha_r = 3.0, alpha_i = 1.5 + */ +CTEST(zimatcopy, c_api_colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha[] = {3.0, 1.5}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha_r = 3.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, c_api_rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha[] = {3.0, 1.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, c_api_colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'R'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, c_api_colmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'C'; + double alpha[] = {2.0, 1.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha_r = 1.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, c_api_rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha[] = {1.0, 1.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zimatcopy, c_api_rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'R'; + double alpha[] = {1.5, -1.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, c_api_rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'C'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(zimatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(zimatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(zimatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda_src = 0, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(zimatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda_src = 100, lda_dst = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using row major layout, + * lda_src must be at least n. + */ +CTEST(zimatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using column major layout, + * lda_src must be at least m. + */ +CTEST(zimatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is no transposition, lda_dst must be at least n. + */ +CTEST(zimatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is transposition, lda_dst must be at least m. + */ +CTEST(zimatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is no transposition, lda_dst must be at least m. + */ +CTEST(zimatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is transposition, lda_dst must be at least n. + */ +CTEST(zimatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zomatcopy.c b/utest/test_extensions/test_zomatcopy.c new file mode 100644 index 000000000..8df3dd80f --- /dev/null +++ b/utest/test_extensions/test_zomatcopy.c @@ -0,0 +1,745 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_ZOMATCOPY { + double a_test[DATASIZE * DATASIZE * 2]; + double b_test[DATASIZE * DATASIZE * 2]; + double b_verify[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZOMATCOPY data_zomatcopy; + +/** + * Comapare results computed by zomatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param alpha - scaling factor for matrix B + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * return norm of difference between openblas and reference func + */ +static double check_zomatcopy(char api, char order, char trans, blasint rows, blasint cols, double* alpha, + blasint lda, blasint ldb) +{ + blasint b_rows, b_cols; + blasint m, n; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + int conj = -1; + + if (order == 'C') { + m = cols; n = rows; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + b_rows = n; b_cols = m*2; + if (trans == 'C') + conj = 1; + } + else { + b_rows = m; b_cols = n*2; + if (trans == 'R') + conj = 1; + } + + drand_generate(data_zomatcopy.a_test, lda*m*2); + + if (trans == 'T' || trans == 'C') { + ztranspose(m, n, alpha, data_zomatcopy.a_test, lda, data_zomatcopy.b_verify, ldb, conj); + } + else { + zcopy(m, n, alpha, data_zomatcopy.a_test, lda, data_zomatcopy.b_verify, ldb, conj); + } + + if (api == 'F') { + BLASFUNC(zomatcopy)(&order, &trans, &rows, &cols, alpha, data_zomatcopy.a_test, + &lda, data_zomatcopy.b_test, &ldb); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_zomatcopy(corder, ctrans, rows, cols, alpha, data_zomatcopy.a_test, + lda, data_zomatcopy.b_test, ldb); + } + + return dmatrix_difference(data_zomatcopy.b_test, data_zomatcopy.b_verify, b_cols, b_rows, ldb*2); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda, blasint ldb, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + + set_xerbla("ZOMATCOPY", expected_info); + + BLASFUNC(zomatcopy)(&order, &trans, &rows, &cols, alpha, data_zomatcopy.a_test, + &lda, data_zomatcopy.b_test, &ldb); + + return check_error(); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + double alpha[] = {1.0, 2.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * alpha_r = -1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + double alpha[] = {-1.0, 2.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'R'; + double alpha[] = {1.0, 2.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(zomatcopy, colmajor_conjtrnas_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'C'; + double alpha[] = {2.0, 1.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zomatcopy, rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 50; + char order = 'R'; + char trans = 'N'; + double alpha[] = {1.5, -1.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zomatcopy, rowmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + double alpha[] = {1.5, -1.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zomatcopy, rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'R'; + double alpha[] = {1.5, -1.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'C'; + double alpha[] = {1.0, 2.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, c_api_colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + double alpha[] = {1.0, 2.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * alpha_r = -1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, c_api_colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + double alpha[] = {-1.0, 2.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, c_api_colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'R'; + double alpha[] = {1.0, 2.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(zomatcopy, c_api_colmajor_conjtrnas_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'C'; + double alpha[] = {2.0, 1.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zomatcopy, c_api_rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 50; + char order = 'R'; + char trans = 'N'; + double alpha[] = {1.5, -1.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zomatcopy, c_api_rowmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + double alpha[] = {1.5, -1.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zomatcopy, c_api_rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'R'; + double alpha[] = {1.5, -1.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, c_api_rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'C'; + double alpha[] = {1.0, 2.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** +* Test error function for an invalid param order. +* Must be column (C) or row major (R). +*/ +CTEST(zomatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param trans. +* Must be trans (T/C) or no-trans (N/R). +*/ +CTEST(zomatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param m. +* Must be positive. +*/ +CTEST(zomatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda = 0, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param n. +* Must be positive. +*/ +CTEST(zomatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda = 100, ldb = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param lda. +* If matrices are stored using row major layout, +* lda must be at least n. +*/ +CTEST(zomatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param lda. +* If matrices are stored using column major layout, +* lda must be at least m. +*/ +CTEST(zomatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using row major layout and +* there is no transposition, ldb must be at least n. +*/ +CTEST(zomatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using row major layout and +* there is transposition, ldb must be at least m. +*/ +CTEST(zomatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using row major layout and +* there is no transposition, ldb must be at least n. +*/ +CTEST(zomatcopy, xerbla_rowmajor_conj_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'R'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using row major layout and +* there is transposition, ldb must be at least m. +*/ +CTEST(zomatcopy, xerbla_rowmajor_transconj_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'C'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using column major layout and +* there is no transposition, ldb must be at least m. +*/ +CTEST(zomatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using column major layout and +* there is transposition, ldb must be at least n. +*/ +CTEST(zomatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using column major layout and +* there is no transposition, ldb must be at least m. +*/ +CTEST(zomatcopy, xerbla_colmajor_conj_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'R'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using column major layout and +* there is transposition, ldb must be at least n. +*/ +CTEST(zomatcopy, xerbla_colmajor_transconj_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'C'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif diff --git a/utest/test_extensions/test_zrot.c b/utest/test_extensions/test_zrot.c new file mode 100644 index 000000000..5471e051a --- /dev/null +++ b/utest/test_extensions/test_zrot.c @@ -0,0 +1,790 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZROT { + double x_test[DATASIZE * INCREMENT * 2]; + double y_test[DATASIZE * INCREMENT * 2]; + double x_verify[DATASIZE * INCREMENT * 2]; + double y_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZROT data_zrot; + +/** + * Comapare results computed by zdrot and zaxpby + * + * param n specifies size of vector x + * param inc_x specifies increment of vector x + * param inc_y specifies increment of vector y + * param c specifies cosine + * param s specifies sine + * return norm of differences + */ +static double check_zdrot(blasint n, blasint inc_x, blasint inc_y, double *c, double *s) +{ + blasint i; + double norm = 0; + double s_neg[] = {-s[0], s[1]}; + + blasint inc_x_abs = labs(inc_x); + blasint inc_y_abs = labs(inc_y); + + // Fill vectors x, y + drand_generate(data_zrot.x_test, n * inc_x_abs * 2); + drand_generate(data_zrot.y_test, n * inc_y_abs * 2); + + if (inc_x == 0 && inc_y == 0) { + drand_generate(data_zrot.x_test, n * 2); + drand_generate(data_zrot.y_test, n * 2); + } + + // Copy vector x for zaxpby + for (i = 0; i < n * inc_x_abs * 2; i++) + data_zrot.x_verify[i] = data_zrot.x_test[i]; + + // Copy vector y for zaxpby + for (i = 0; i < n * inc_y_abs * 2; i++) + data_zrot.y_verify[i] = data_zrot.y_test[i]; + + // Find cx = c*x + s*y + BLASFUNC(zaxpby)(&n, s, data_zrot.y_test, &inc_y, c, data_zrot.x_verify, &inc_x); + + // Find cy = -conjg(s)*x + c*y + BLASFUNC(zaxpby)(&n, s_neg, data_zrot.x_test, &inc_x, c, data_zrot.y_verify, &inc_y); + + BLASFUNC(zdrot)(&n, data_zrot.x_test, &inc_x, data_zrot.y_test, &inc_y, c, s); + + // Find the differences between vector x caculated by zaxpby and zdrot + for (i = 0; i < n * 2 * inc_x_abs; i++) + data_zrot.x_test[i] -= data_zrot.x_verify[i]; + + // Find the differences between vector y caculated by zaxpby and zdrot + for (i = 0; i < n * 2 * inc_y_abs; i++) + data_zrot.y_test[i] -= data_zrot.y_verify[i]; + + // Find the norm of differences + norm += BLASFUNC(dznrm2)(&n, data_zrot.x_test, &inc_x_abs); + norm += BLASFUNC(dznrm2)(&n, data_zrot.y_test, &inc_y_abs); + return (norm / 2); +} + +/** + * C API specific function + * Comapare results computed by zdrot and zaxpby + * + * param n specifies size of vector x + * param inc_x specifies increment of vector x + * param inc_y specifies increment of vector y + * param c specifies cosine + * param s specifies sine + * return norm of differences + */ +static double c_api_check_zdrot(blasint n, blasint inc_x, blasint inc_y, double *c, double *s) +{ + blasint i; + double norm = 0; + double s_neg[] = {-s[0], s[1]}; + + blasint inc_x_abs = labs(inc_x); + blasint inc_y_abs = labs(inc_y); + + // Fill vectors x, y + drand_generate(data_zrot.x_test, n * inc_x_abs * 2); + drand_generate(data_zrot.y_test, n * inc_y_abs * 2); + + if (inc_x == 0 && inc_y == 0) { + drand_generate(data_zrot.x_test, n * 2); + drand_generate(data_zrot.y_test, n * 2); + } + + // Copy vector x for zaxpby + for (i = 0; i < n * inc_x_abs * 2; i++) + data_zrot.x_verify[i] = data_zrot.x_test[i]; + + // Copy vector y for zaxpby + for (i = 0; i < n * inc_y_abs * 2; i++) + data_zrot.y_verify[i] = data_zrot.y_test[i]; + + // Find cx = c*x + s*y + cblas_zaxpby(n, s, data_zrot.y_test, inc_y, c, data_zrot.x_verify, inc_x); + + // Find cy = -conjg(s)*x + c*y + cblas_zaxpby(n, s_neg, data_zrot.x_test, inc_x, c, data_zrot.y_verify, inc_y); + + cblas_zdrot(n, data_zrot.x_test, inc_x, data_zrot.y_test, inc_y, c[0], s[0]); + + // Find the differences between vector x caculated by zaxpby and zdrot + for (i = 0; i < n * 2 * inc_x_abs; i++) + data_zrot.x_test[i] -= data_zrot.x_verify[i]; + + // Find the differences between vector y caculated by zaxpby and zdrot + for (i = 0; i < n * 2 * inc_y_abs; i++) + data_zrot.y_test[i] -= data_zrot.y_verify[i]; + + // Find the norm of differences + norm += cblas_dznrm2(n, data_zrot.x_test, inc_x_abs); + norm += cblas_dznrm2(n, data_zrot.y_test, inc_y_abs); + return (norm / 2); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 0 + * Stride of vector y is 0 + * c = 1.0 + * s = 2.0 + */ +CTEST(zrot, inc_x_0_inc_y_0) +{ + blasint n = 100; + + blasint inc_x = 0; + blasint inc_y = 0; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {2.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_1_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is -1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_neg_1_inc_y_neg_1) +{ + blasint n = 100; + + blasint inc_x = -1; + blasint inc_y = -1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * c = 3.0 + * s = 2.0 + */ +CTEST(zrot, inc_x_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {3.0, 0.0}; + double s[] = {2.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is 1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_neg_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_1_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is -2 + * c = 2.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_1_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = -2; + + // Imaginary part for zaxpby + double c[] = {2.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0 + * s = 2.0 + */ +CTEST(zrot, inc_x_2_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {2.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_neg_2_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = -2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 0.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_2_inc_y_2_c_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {0.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0 + * s = 0.0 + */ +CTEST(zrot, inc_x_2_inc_y_2_s_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {0.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 0 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, check_n_zero) +{ + blasint n = 0; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 0 + * Stride of vector y is 0 + * c = 1.0 + * s = 2.0 + */ +CTEST(zrot, c_api_inc_x_0_inc_y_0) +{ + blasint n = 100; + + blasint inc_x = 0; + blasint inc_y = 0; + + // Imaginary part for zaxpby + double c[] = {3.0, 0.0}; + double s[] = {2.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_1_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is -1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_neg_1_inc_y_neg_1) +{ + blasint n = 100; + + blasint inc_x = -1; + blasint inc_y = -1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * c = 3.0 + * s = 2.0 + */ +CTEST(zrot, c_api_inc_x_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {3.0, 0.0}; + double s[] = {2.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is 1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_neg_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_1_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is -2 + * c = 2.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_1_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = -2; + + // Imaginary part for zaxpby + double c[] = {2.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0 + * s = 2.0 + */ +CTEST(zrot, c_api_inc_x_2_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {2.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_neg_2_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = -2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 0.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_2_inc_y_2_c_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {0.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0 + * s = 0.0 + */ +CTEST(zrot, c_api_inc_x_2_inc_y_2_s_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {0.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 0 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, c_api_check_n_zero) +{ + blasint n = 0; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zrotg.c b/utest/test_extensions/test_zrotg.c new file mode 100644 index 000000000..310121422 --- /dev/null +++ b/utest/test_extensions/test_zrotg.c @@ -0,0 +1,290 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#ifdef BUILD_COMPLEX16 + +/** + * Fortran API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, zero_a) +{ + double sa[2] = {0.0, 0.0}; + double sb[2] = {1.0, 1.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.0, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[1], DOUBLE_EPS); +} + +/** + * Fortran API specific tests + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, zero_b) +{ + double sa[2] = {1.0, 1.0}; + double sb[2] = {0.0, 0.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(1.0, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[1], DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, zero_real) +{ + double sa[2] = {0.0, 1.0}; + double sb[2] = {0.0, 1.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.70710678118654, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70710678118654, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421356237309, sa[1], DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, positive_real_positive_img) +{ + double sa[2] = {3.0, 4.0}; + double sb[2] = {4.0, 6.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, negative_real_positive_img) +{ + double sa[2] = {-3.0, 4.0}; + double sb[2] = {-4.0, 6.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, positive_real_negative_img) +{ + double sa[2] = {3.0, -4.0}; + double sb[2] = {4.0, -6.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, negative_real_negative_img) +{ + double sa[2] = {-3.0, -4.0}; + double sb[2] = {-4.0, -6.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_zero_a) +{ + double sa[2] = {0.0, 0.0}; + double sb[2] = {1.0, 1.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.0, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_zero_b) +{ + double sa[2] = {1.0, 1.0}; + double sb[2] = {0.0, 0.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(1.0, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_zero_real) +{ + double sa[2] = {0.0, 1.0}; + double sb[2] = {0.0, 1.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.70710678118654, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70710678118654, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421356237309, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_positive_real_positive_img) +{ + double sa[2] = {3.0, 4.0}; + double sb[2] = {4.0, 6.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_negative_real_positive_img) +{ + double sa[2] = {-3.0, 4.0}; + double sb[2] = {-4.0, 6.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_positive_real_negative_img) +{ + double sa[2] = {3.0, -4.0}; + double sb[2] = {4.0, -6.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_negative_real_negative_img) +{ + double sa[2] = {-3.0, -4.0}; + double sb[2] = {-4.0, -6.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997150991369, sa[1], DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zsbmv.c b/utest/test_extensions/test_zsbmv.c new file mode 100644 index 000000000..afdb208c1 --- /dev/null +++ b/utest/test_extensions/test_zsbmv.c @@ -0,0 +1,606 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZSBMV { + double sp_matrix[DATASIZE * (DATASIZE + 1)]; + double sb_matrix[DATASIZE * DATASIZE * 2]; + double b_test[DATASIZE * 2 * INCREMENT]; + double c_test[DATASIZE * 2 * INCREMENT]; + double c_verify[DATASIZE * 2 * INCREMENT]; +}; + +// DOUBLE_EPS_ZGEMV = MAX_VAL * NUMBER OF OPERATIONS * DBL_EPSILON +// DOUBLE_EPS_ZGEMV = 5.0 * O(100 * 100) * 2.2e-16 = 1e-11 +#define DOUBLE_EPS_ZGEMV 1e-11 + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZSBMV data_zsbmv; + +/** + * Transform full-storage symmetric band matrix A to upper (U) or lower (L) + * band-packed storage mode. + * + * param uplo specifies whether matrix a is upper or lower band-packed. + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + * output param a - buffer for holding symmetric band-packed matrix + * param lda - specifies the leading dimension of a + * param sb_matrix - buffer holding full-storage symmetric band matrix A + * param ldm - specifies the leading dimension of A + */ +static void transform_to_band_storage(char uplo, blasint n, blasint k, double* a, blasint lda, + double* sb_matrix, blasint ldm) +{ + blasint i, j, m; + if (uplo == 'L') { + for (j = 0; j < n; j++) + { + m = -j; + for (i = 2 * j; i < MIN(2 * n, 2 * (j + k + 1)); i += 2) + { + a[(2*m + i) + j * lda * 2] = sb_matrix[i + j * ldm * 2]; + a[(2*m + (i + 1)) + j * lda * 2] = sb_matrix[(i + 1) + j * ldm * 2]; + } + } + } + else { + for (j = 0; j < n; j++) + { + m = k - j; + for (i = MAX(0, 2*(j - k)); i <= j*2; i += 2) + { + a[(2*m + i) + j * lda * 2] = sb_matrix[i + j * ldm * 2]; + a[(2*m + (i + 1)) + j * lda * 2] = sb_matrix[(i + 1) + j * ldm * 2]; + } + } + } +} + +/** + * Generate full-storage symmetric band matrix A with k - super-diagonals + * from input symmetric packed matrix in lower packed mode (L) + * + * output param sb_matrix - buffer for holding full-storage symmetric band matrix. + * param sp_matrix - buffer holding input symmetric packed matrix + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + */ +static void get_symmetric_band_matr(double *sb_matrix, double *sp_matrix, blasint n, blasint k) +{ + blasint m; + blasint i, j; + m = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < n * 2; j += 2) + { + // Make matrix band with k super-diagonals + if (fabs((i+1) - ceil((j+1)/2.0)) > k) + { + sb_matrix[i * n * 2 + j] = 0.0; + sb_matrix[i * n * 2 + j + 1] = 0.0; + continue; + } + + if (j / 2 < i) + { + sb_matrix[i * n * 2 + j] = + sb_matrix[j * n + i * 2]; + sb_matrix[i * n * 2 + j + 1] = + sb_matrix[j * n + i * 2 + 1]; + } + else + { + sb_matrix[i * n * 2 + j] = sp_matrix[m++]; + sb_matrix[i * n * 2 + j + 1] = sp_matrix[m++]; + } + } + } +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether matrix a is upper or lower band-packed. + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + * param lda - specifies the leading dimension of a + * param inc_b - stride of vector b_test + * param inc_c - stride of vector c_test + * param expected_info - expected invalid parameter number in zsbmv + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char uplo, blasint n, blasint k, blasint lda, blasint inc_b, + blasint inc_c, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double a[2]; + drand_generate(a, 2); + + set_xerbla("ZSBMV ", expected_info); + + BLASFUNC(zsbmv)(&uplo, &n, &k, alpha, a, &lda, data_zsbmv.b_test, + &inc_b, beta, data_zsbmv.c_test, &inc_c); + + return check_error(); +} + +/** + * Comapare results computed by zsbmv and zgemv + * since zsbmv is zgemv for symmetric band matrix + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + * param alpha - scaling factor for the matrix-vector product + * param lda - specifies the leading dimension of a + * param inc_b - stride of vector b_test + * param beta - scaling factor for vector c_test + * param inc_c - stride of vector c_test + * param lda - specifies the leading dimension of a + * return norm of differences + */ +static double check_zsbmv(char uplo, blasint n, blasint k, double *alpha, blasint lda, + blasint inc_b, double *beta, blasint inc_c, blasint ldm) +{ + blasint i; + + // Trans param for gemv (can use any, since the input matrix is symmetric) + char trans = 'N'; + + // Symmetric band packed matrix for sbmv + double a[lda * n * 2]; + + // Fill symmetric packed matrix sp_matrix, vector b_test, vector c_test + drand_generate(data_zsbmv.sp_matrix, n * (n + 1)); + drand_generate(data_zsbmv.b_test, n * inc_b * 2); + drand_generate(data_zsbmv.c_test, n * inc_c * 2); + + // Copy vector c_test for zgemv + for (i = 0; i < n * inc_c * 2; i++) + data_zsbmv.c_verify[i] = data_zsbmv.c_test[i]; + + // Generate full-storage symmetric band matrix + // with k super-diagonals from symmetric packed matrix + get_symmetric_band_matr(data_zsbmv.sb_matrix, data_zsbmv.sp_matrix, n, k); + + // Transform symmetric band matrix from conventional + // full matrix storage to band storage for zsbmv + transform_to_band_storage(uplo, n, k, a, lda, data_zsbmv.sb_matrix, ldm); + + BLASFUNC(zgemv)(&trans, &n, &n, alpha, data_zsbmv.sb_matrix, &ldm, data_zsbmv.b_test, + &inc_b, beta, data_zsbmv.c_verify, &inc_c); + + BLASFUNC(zsbmv)(&uplo, &n, &k, alpha, a, &lda, + data_zsbmv.b_test, &inc_b, beta, data_zsbmv.c_test, &inc_c); + + // Find the differences between output vector caculated by zsbmv and zgemv + for (i = 0; i < n * inc_c * 2; i++) + data_zsbmv.c_test[i] -= data_zsbmv.c_verify[i]; + + // Find the norm of differences + return BLASFUNC(dznrm2)(&n, data_zsbmv.c_test, &inc_c); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 0 + */ +CTEST(zsbmv, upper_k_0_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 1 + */ +CTEST(zsbmv, upper_k_1_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 1; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(zsbmv, upper_k_2_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(zsbmv, upper_k_2_inc_b_2_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 2 + * Number of super-diagonals k is 2 + */ +CTEST(zsbmv, upper_k_2_inc_b_2_inc_c_2_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 2; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 0 + */ +CTEST(zsbmv, lower_k_0_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 1 + */ +CTEST(zsbmv, lower_k_1_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 1; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(zsbmv, lower_k_2_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(zsbmv, lower_k_2_inc_b_2_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 2 + * Number of super-diagonals k is 2 + */ +CTEST(zsbmv, lower_k_2_inc_b_2_inc_c_2_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 2; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Check if output matrix a contains any NaNs + */ +CTEST(zsbmv, check_for_NaN) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + + ASSERT_TRUE(norm == norm); /* NaN == NaN is false */ +} + +/** + * Test error function for an invalid param uplo. + * Uplo specifies whether a is in upper (U) or lower (L) band-packed storage mode. + */ +CTEST(zsbmv, xerbla_uplo_invalid) +{ + blasint n = 1, inc_b = 1, inc_c = 1; + char uplo = 'O'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 1; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param N - + * number of rows and columns of A. Must be at least zero. + */ +CTEST(zsbmv, xerbla_n_invalid) +{ + blasint n = INVALID, inc_b = 1, inc_c = 1; + char uplo = 'U'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 2; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Check if n - number of rows and columns of A equal zero. + */ +CTEST(zsbmv, check_n_zero) +{ + blasint n = 0, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = 1; + char uplo = 'U'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test error function for an invalid param inc_b - + * stride of vector b_test. Can't be zero. + */ +CTEST(zsbmv, xerbla_inc_b_zero) +{ + blasint n = 1, inc_b = 0, inc_c = 1; + char uplo = 'U'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 8; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param inc_c - + * stride of vector c_test. Can't be zero. + */ +CTEST(zsbmv, xerbla_inc_c_zero) +{ + blasint n = 1, inc_b = 1, inc_c = 0; + char uplo = 'U'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 11; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param k - + * number of super-diagonals of A. Must be at least zero. + */ +CTEST(zsbmv, xerbla_k_invalid) +{ + blasint n = 1, inc_b = 1, inc_c = 1; + char uplo = 'U'; + blasint k = INVALID; + blasint lda = 1; + int expected_info = 3; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda - + * specifies the leading dimension of a. Must be at least (k+1). + */ +CTEST(zsbmv, xerbla_lda_invalid) +{ + blasint n = 1, inc_b = 1, inc_c = 1; + char uplo = 'U'; + blasint k = 0; + blasint lda = INVALID; + int expected_info = 6; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zscal.c b/utest/test_extensions/test_zscal.c new file mode 100644 index 000000000..132f4ee5b --- /dev/null +++ b/utest/test_extensions/test_zscal.c @@ -0,0 +1,165 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZSCAL { + double x_test[DATASIZE * 2 * INCREMENT]; + double x_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZSCAL data_zscal; + + +/** + * zscal reference code + * + * param n - number of elements of vector x + * param alpha - scaling factor for the vector product + * param x - buffer holding input vector x + * param inc - stride of vector x + */ +static void zscal_trusted(blasint n, double *alpha, double* x, blasint inc){ + blasint i, ip = 0; + blasint inc_x2 = 2 * inc; + double temp; + for (i = 0; i < n; i++) + { + temp = alpha[0] * x[ip] - alpha[1] * x[ip+1]; + x[ip+1] = alpha[0] * x[ip+1] + alpha[1] * x[ip]; + x[ip] = temp; + ip += inc_x2; + } +} + +/** + * Comapare results computed by zscal and zscal_trusted + * + * param api specifies tested api (C or Fortran) + * param n - number of elements of vector x + * param alpha - scaling factor for the vector product + * param inc - stride of vector x + * return norm of differences + */ +static double check_zscal(char api, blasint n, double *alpha, blasint inc) +{ + blasint i; + + // Fill vectors x + drand_generate(data_zscal.x_test, n * inc * 2); + + // Copy vector x for zscal_trusted + for (i = 0; i < n * 2 * inc; i++) + data_zscal.x_verify[i] = data_zscal.x_test[i]; + + zscal_trusted(n, alpha, data_zscal.x_verify, inc); + + if(api == 'F') + BLASFUNC(zscal)(&n, alpha, data_zscal.x_test, &inc); + else + cblas_zscal(n, alpha, data_zscal.x_test, inc); + + // Find the differences between output vector computed by zscal and zscal_trusted + for (i = 0; i < n * 2 * inc; i++) + data_zscal.x_verify[i] -= data_zscal.x_test[i]; + + // Find the norm of differences + return BLASFUNC(dznrm2)(&n, data_zscal.x_verify, &inc); +} + +/** + * Fortran API specific test + * Test zscal by comparing it against reference + */ +CTEST(zscal, alpha_r_zero_alpha_i_not_zero) +{ + blasint N = DATASIZE; + blasint inc = 1; + double alpha[2] = {0.0, 1.0}; + + double norm = check_zscal('F', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zscal by comparing it against reference + */ +CTEST(zscal, alpha_r_zero_alpha_i_zero_inc_2) +{ + blasint N = DATASIZE; + blasint inc = 2; + double alpha[2] = {0.0, 0.0}; + + double norm = check_zscal('F', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zscal by comparing it against reference + */ +CTEST(zscal, c_api_alpha_r_zero_alpha_i_not_zero) +{ + blasint N = DATASIZE; + blasint inc = 1; + double alpha[2] = {0.0, 1.0}; + + double norm = check_zscal('C', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zscal by comparing it against reference + */ +CTEST(zscal, c_api_alpha_r_zero_alpha_i_zero_inc_2) +{ + blasint N = DATASIZE; + blasint inc = 2; + double alpha[2] = {0.0, 0.0}; + + double norm = check_zscal('C', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zspmv.c b/utest/test_extensions/test_zspmv.c new file mode 100644 index 000000000..510ac0579 --- /dev/null +++ b/utest/test_extensions/test_zspmv.c @@ -0,0 +1,427 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZSPMV { + double a_verify[DATASIZE * DATASIZE * 2]; + double a_test[DATASIZE * (DATASIZE + 1)]; + double b_test[DATASIZE * 2 * INCREMENT]; + double c_test[DATASIZE * 2 * INCREMENT]; + double c_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZSPMV data_zspmv; + +/** + * Compute spmv via gemv since spmv is gemv for symmetric packed matrix + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param alpha - scaling factor for the matrix-vector product + * param a - buffer holding input matrix A + * param b - Buffer holding input vector b + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param c - buffer holding input/output vector c + * param inc_c - stride of vector c + * output param data_zspmv.c_verify - matrix computed by gemv + */ +static void zspmv_trusted(char uplo, blasint n, double *alpha, double *a, + double *b, blasint inc_b, double *beta, double *c, + blasint inc_c) +{ + blasint k; + blasint i, j; + + // param for gemv (can use any, since the input matrix is symmetric) + char trans = 'N'; + + // Unpack the input symmetric packed matrix + if (uplo == 'L') + { + k = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < n * 2; j += 2) + { + if (j / 2 < i) + { + data_zspmv.a_verify[i * n * 2 + j] = + data_zspmv.a_verify[j * n + i * 2]; + data_zspmv.a_verify[i * n * 2 + j + 1] = + data_zspmv.a_verify[j * n + i * 2 + 1]; + } + else + { + data_zspmv.a_verify[i * n * 2 + j] = a[k++]; + data_zspmv.a_verify[i * n * 2 + j + 1] = a[k++]; + } + } + } + } + else + { + k = n * (n + 1) - 1; + for (j = 2 * n - 1; j >= 0; j -= 2) + { + for (i = n - 1; i >= 0; i--) + { + if (j / 2 < i) + { + data_zspmv.a_verify[i * n * 2 + j] = + data_zspmv.a_verify[(j - 1) * n + i * 2 + 1]; + data_zspmv.a_verify[i * n * 2 + j - 1] = + data_zspmv.a_verify[(j - 1) * n + i * 2]; + } + else + { + data_zspmv.a_verify[i * n * 2 + j] = a[k--]; + data_zspmv.a_verify[i * n * 2 + j - 1] = a[k--]; + } + } + } + } + + // Run gemv with unpacked matrix + BLASFUNC(zgemv)(&trans, &n, &n, alpha, data_zspmv.a_verify, &n, b, + &inc_b, beta, c, &inc_c); +} + +/** + * Comapare results computed by zspmv and zspmv_trusted + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param alpha - scaling factor for the matrix-vector product + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param inc_c - stride of vector c + * return norm of differences + */ +static double check_zspmv(char uplo, blasint n, double *alpha, blasint inc_b, + double *beta, blasint inc_c) +{ + blasint i; + + // Fill symmetric packed maxtix a, vectors b and c + drand_generate(data_zspmv.a_test, n * (n + 1)); + drand_generate(data_zspmv.b_test, 2 * n * inc_b); + drand_generate(data_zspmv.c_test, 2 * n * inc_c); + + // Copy vector c for zspmv_trusted + for (i = 0; i < n * 2 * inc_c; i++) + data_zspmv.c_verify[i] = data_zspmv.c_test[i]; + + zspmv_trusted(uplo, n, alpha, data_zspmv.a_test, data_zspmv.b_test, + inc_b, beta, data_zspmv.c_verify, inc_c); + BLASFUNC(zspmv)(&uplo, &n, alpha, data_zspmv.a_test, data_zspmv.b_test, + &inc_b, beta, data_zspmv.c_test, &inc_c); + + // Find the differences between output vector caculated by zspmv and zspmv_trusted + for (i = 0; i < n * 2 * inc_c; i++) + data_zspmv.c_test[i] -= data_zspmv.c_verify[i]; + + // Find the norm of differences + return BLASFUNC(dznrm2)(&n, data_zspmv.c_test, &inc_c); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param inc_b - stride of vector b + * param inc_c - stride of vector c + * param expected_info - expected invalid parameter number in zspmv + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char uplo, blasint n, blasint inc_b, + blasint inc_c, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + set_xerbla("ZSPMV ", expected_info); + + BLASFUNC(zspmv)(&uplo, &n, alpha, data_zspmv.a_test, data_zspmv.b_test, + &inc_b, beta, data_zspmv.c_test, &inc_c); + + return check_error(); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zspmv, upper_inc_b_1_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 2 + */ +CTEST(zspmv, upper_inc_b_1_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 2; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 1 + */ +CTEST(zspmv, upper_inc_b_2_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 1; + char uplo = 'U'; + double alpha[] = {1.0, 0.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(zspmv, upper_inc_b_2_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 2; + char uplo = 'U'; + double alpha[] = {2.5, -2.1}; + double beta[] = {0.0, 1.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zspmv, lower_inc_b_1_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'L'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 2 + */ +CTEST(zspmv, lower_inc_b_1_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 2; + char uplo = 'L'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 1 + */ +CTEST(zspmv, lower_inc_b_2_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 1; + char uplo = 'L'; + double alpha[] = {1.0, 0.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(zspmv, lower_inc_b_2_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 2; + char uplo = 'L'; + double alpha[] = {2.5, -2.1}; + double beta[] = {0.0, 1.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Check if output matrix A contains any NaNs + */ +CTEST(zspmv, check_for_NaN) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_TRUE(norm == norm); /* NaN == NaN is false */ +} + +/** + * Test error function for an invalid param uplo. + * uplo specifies whether A is upper or lower triangular. + */ +CTEST(zspmv, xerbla_uplo_invalid) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'O'; + int expected_info = 1; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param N - + * number of rows and columns of A. Must be at least zero. + */ +CTEST(zspmv, xerbla_N_invalid) +{ + blasint N = INVALID, inc_b = 1, inc_c = 1; + char uplo = 'U'; + int expected_info = 2; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param inc_b - + * stride of vector b. Can't be zero. + */ +CTEST(zspmv, xerbla_inc_b_zero) +{ + blasint N = DATASIZE, inc_b = 0, inc_c = 1; + char uplo = 'U'; + int expected_info = 6; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param inc_c - + * stride of vector c. Can't be zero. + */ +CTEST(zspmv, xerbla_inc_c_zero) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 0; + char uplo = 'U'; + int expected_info = 9; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif diff --git a/utest/test_extensions/test_ztrmv.c b/utest/test_extensions/test_ztrmv.c new file mode 100644 index 000000000..aad64099e --- /dev/null +++ b/utest/test_extensions/test_ztrmv.c @@ -0,0 +1,266 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 300 +#define INCREMENT 2 + +struct DATA_ZTRMV { + double a_test[DATASIZE * DATASIZE * 2]; + double a_verify[DATASIZE * DATASIZE * 2]; + double x_test[DATASIZE * INCREMENT * 2]; + double x_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZTRMV data_ztrmv; + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * + * param uplo specifies whether A is upper or lower triangular + * param trans specifies op(A), the transposition (conjugation) operation applied to A + * param diag specifies whether the matrix A is unit triangular or not. + * param n - numbers of rows and columns of A + * param lda - leading dimension of matrix A + * param incx - increment for the elements of x + * return norm of difference + */ +static double check_ztrmv(char uplo, char trans, char diag, blasint n, blasint lda, blasint incx) +{ + blasint i; + double alpha_conj[] = {1.0, 0.0}; + char trans_verify = trans; + + srand_generate(data_ztrmv.a_test, n * lda * 2); + srand_generate(data_ztrmv.x_test, n * incx * 2); + + for (i = 0; i < n * lda * 2; i++) + data_ztrmv.a_verify[i] = data_ztrmv.a_test[i]; + + for (i = 0; i < n * incx * 2; i++) + data_ztrmv.x_verify[i] = data_ztrmv.x_test[i]; + + if (trans == 'R'){ + cblas_zimatcopy(CblasColMajor, CblasConjNoTrans, n, n, alpha_conj, data_ztrmv.a_verify, lda, lda); + trans_verify = 'N'; + } + + BLASFUNC(ztrmv)(&uplo, &trans_verify, &diag, &n, data_ztrmv.a_verify, &lda, + data_ztrmv.x_verify, &incx); + + BLASFUNC(ztrmv)(&uplo, &trans, &diag, &n, data_ztrmv.a_test, &lda, + data_ztrmv.x_test, &incx); + + for (i = 0; i < n * incx * 2; i++) + data_ztrmv.x_verify[i] -= data_ztrmv.x_test[i]; + + return BLASFUNC(dznrm2)(&n, data_ztrmv.x_verify, &incx); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + */ +CTEST(ztrmv, conj_notrans_upper_not_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + */ +CTEST(ztrmv, conj_notrans_upper_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + */ +CTEST(ztrmv, conj_notrans_lower_not_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + */ +CTEST(ztrmv, conj_notrans_lower_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ztrmv, conj_notrans_upper_not_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ztrmv, conj_notrans_upper_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ztrmv, conj_notrans_lower_not_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ztrmv, conj_notrans_lower_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_ztrsv.c b/utest/test_extensions/test_ztrsv.c new file mode 100644 index 000000000..ae556f5e2 --- /dev/null +++ b/utest/test_extensions/test_ztrsv.c @@ -0,0 +1,267 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 300 +#define INCREMENT 2 + +struct DATA_ZTRSV { + double a_test[DATASIZE * DATASIZE * 2]; + double a_verify[DATASIZE * DATASIZE * 2]; + double x_test[DATASIZE * INCREMENT * 2]; + double x_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZTRSV data_ztrsv; + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * + * param uplo specifies whether A is upper or lower triangular + * param trans specifies op(A), the transposition (conjugation) operation applied to A + * param diag specifies whether the matrix A is unit triangular or not. + * param n - numbers of rows and columns of A + * param lda - leading dimension of matrix A + * param incx - increment for the elements of x + * return norm of difference + */ +static double check_ztrsv(char uplo, char trans, char diag, blasint n, blasint lda, blasint incx) +{ + blasint i; + double alpha_conj[] = {1.0, 0.0}; + char trans_verify = trans; + + srand_generate(data_ztrsv.a_test, n * lda * 2); + srand_generate(data_ztrsv.x_test, n * incx * 2); + + for (i = 0; i < n * lda * 2; i++) + data_ztrsv.a_verify[i] = data_ztrsv.a_test[i]; + + for (i = 0; i < n * incx * 2; i++) + data_ztrsv.x_verify[i] = data_ztrsv.x_test[i]; + + if (trans == 'R'){ + cblas_zimatcopy(CblasColMajor, CblasConjNoTrans, n, n, + alpha_conj, data_ztrsv.a_verify, lda, lda); + trans_verify = 'N'; + } + + BLASFUNC(ztrsv)(&uplo, &trans_verify, &diag, &n, data_ztrsv.a_verify, + &lda, data_ztrsv.x_verify, &incx); + + BLASFUNC(ztrsv)(&uplo, &trans, &diag, &n, data_ztrsv.a_test, &lda, + data_ztrsv.x_test, &incx); + + for (i = 0; i < n * incx * 2; i++) + data_ztrsv.x_verify[i] -= data_ztrsv.x_test[i]; + + return BLASFUNC(dznrm2)(&n, data_ztrsv.x_verify, &incx); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + */ +CTEST(ztrsv, conj_notrans_upper_not_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + */ +CTEST(ztrsv, conj_notrans_upper_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + */ +CTEST(ztrsv, conj_notrans_lower_not_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + */ +CTEST(ztrsv, conj_notrans_lower_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ztrsv, conj_notrans_upper_not_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ztrsv, conj_notrans_upper_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ztrsv, conj_notrans_lower_not_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ztrsv, conj_notrans_lower_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/xerbla.c b/utest/test_extensions/xerbla.c new file mode 100644 index 000000000..9487b20a6 --- /dev/null +++ b/utest/test_extensions/xerbla.c @@ -0,0 +1,88 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "common.h" + +static int link_xerbla=TRUE; +static int lerr, _info, ok; +static char *rout; + +static void F77_xerbla(char *srname, void *vinfo) +{ + int info=*(int*)vinfo; + + if (link_xerbla) + { + link_xerbla = 0; + return; + } + + if (rout != NULL && strcmp(rout, srname) != 0){ + printf("***** XERBLA WAS CALLED WITH SRNAME = <%s> INSTEAD OF <%s> *******\n", srname, rout); + ok = FALSE; + } + + if (info != _info){ + printf("***** XERBLA WAS CALLED WITH INFO = %d INSTEAD OF %d in %s *******\n",info, _info, srname); + lerr = TRUE; + ok = FALSE; + } else lerr = FALSE; +} + +/** +* error function redefinition +*/ +int BLASFUNC(xerbla)(char *name, blasint *info, blasint length) +{ + F77_xerbla(name, info); + return 0; +} + +int check_error(void) { + if (lerr == TRUE ) { + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", _info, rout); + ok = FALSE; + } + lerr = TRUE; + return ok; +} + +void set_xerbla(char* current_rout, int expected_info){ + if (link_xerbla) /* call these first to link */ + F77_xerbla(rout, &_info); + + ok = TRUE; + lerr = TRUE; + _info = expected_info; + rout = current_rout; +} \ No newline at end of file From c99e231fc5bb9ae661547089b561f0a66e99431e Mon Sep 17 00:00:00 2001 From: Andrey Sokolov Date: Thu, 18 Jan 2024 23:54:51 +0300 Subject: [PATCH 02/12] Fix rand_generate --- utest/test_extensions/common.c | 4 ++-- utest/test_extensions/test_zgeadd.c | 4 ++-- utest/test_extensions/test_ztrmv.c | 4 ++-- utest/test_extensions/test_ztrsv.c | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/utest/test_extensions/common.c b/utest/test_extensions/common.c index c3bdcefc7..8a6a47795 100644 --- a/utest/test_extensions/common.c +++ b/utest/test_extensions/common.c @@ -40,14 +40,14 @@ void srand_generate(float *alpha, blasint n) { blasint i; for (i = 0; i < n; i++) - alpha[i] = (float)rand() / (float)RAND_MAX * 5.0f; + alpha[i] = (float)rand() / (float)RAND_MAX; } void drand_generate(double *alpha, blasint n) { blasint i; for (i = 0; i < n; i++) - alpha[i] = (double)rand() / (double)RAND_MAX * 5.0; + alpha[i] = (double)rand() / (double)RAND_MAX; } /** diff --git a/utest/test_extensions/test_zgeadd.c b/utest/test_extensions/test_zgeadd.c index 917c04829..e50f86de0 100644 --- a/utest/test_extensions/test_zgeadd.c +++ b/utest/test_extensions/test_zgeadd.c @@ -103,8 +103,8 @@ static double check_zgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order, } // Fill matrix A, C - srand_generate(data_zgeadd.a_test, lda * rows * 2); - srand_generate(data_zgeadd.c_test, ldc * rows * 2); + drand_generate(data_zgeadd.a_test, lda * rows * 2); + drand_generate(data_zgeadd.c_test, ldc * rows * 2); // Copy matrix C for zgeadd for (i = 0; i < ldc * rows * 2; i++) diff --git a/utest/test_extensions/test_ztrmv.c b/utest/test_extensions/test_ztrmv.c index aad64099e..5668ec296 100644 --- a/utest/test_extensions/test_ztrmv.c +++ b/utest/test_extensions/test_ztrmv.c @@ -66,8 +66,8 @@ static double check_ztrmv(char uplo, char trans, char diag, blasint n, blasint l double alpha_conj[] = {1.0, 0.0}; char trans_verify = trans; - srand_generate(data_ztrmv.a_test, n * lda * 2); - srand_generate(data_ztrmv.x_test, n * incx * 2); + drand_generate(data_ztrmv.a_test, n * lda * 2); + drand_generate(data_ztrmv.x_test, n * incx * 2); for (i = 0; i < n * lda * 2; i++) data_ztrmv.a_verify[i] = data_ztrmv.a_test[i]; diff --git a/utest/test_extensions/test_ztrsv.c b/utest/test_extensions/test_ztrsv.c index ae556f5e2..4b7ec6aaf 100644 --- a/utest/test_extensions/test_ztrsv.c +++ b/utest/test_extensions/test_ztrsv.c @@ -66,8 +66,8 @@ static double check_ztrsv(char uplo, char trans, char diag, blasint n, blasint l double alpha_conj[] = {1.0, 0.0}; char trans_verify = trans; - srand_generate(data_ztrsv.a_test, n * lda * 2); - srand_generate(data_ztrsv.x_test, n * incx * 2); + drand_generate(data_ztrsv.a_test, n * lda * 2); + drand_generate(data_ztrsv.x_test, n * incx * 2); for (i = 0; i < n * lda * 2; i++) data_ztrsv.a_verify[i] = data_ztrsv.a_test[i]; From f68e9989c47d2643fd72986afc59f6a8d7d07486 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Fri, 2 Feb 2024 12:26:23 +0300 Subject: [PATCH 03/12] Remove zero rows/columns matcopy tests --- utest/test_extensions/test_cimatcopy.c | 32 -------------------------- utest/test_extensions/test_comatcopy.c | 32 -------------------------- utest/test_extensions/test_dimatcopy.c | 32 -------------------------- utest/test_extensions/test_domatcopy.c | 32 -------------------------- utest/test_extensions/test_simatcopy.c | 32 -------------------------- utest/test_extensions/test_somatcopy.c | 32 -------------------------- utest/test_extensions/test_zimatcopy.c | 32 -------------------------- utest/test_extensions/test_zomatcopy.c | 32 -------------------------- 8 files changed, 256 deletions(-) diff --git a/utest/test_extensions/test_cimatcopy.c b/utest/test_extensions/test_cimatcopy.c index 800f8a2d1..a4b1e30ac 100644 --- a/utest/test_extensions/test_cimatcopy.c +++ b/utest/test_extensions/test_cimatcopy.c @@ -714,38 +714,6 @@ CTEST(cimatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(cimatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda_src = 0, lda_dst = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(cimatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda_src = 100, lda_dst = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda_src. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_comatcopy.c b/utest/test_extensions/test_comatcopy.c index 8a3d5ee7b..71663406a 100644 --- a/utest/test_extensions/test_comatcopy.c +++ b/utest/test_extensions/test_comatcopy.c @@ -524,38 +524,6 @@ CTEST(comatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(comatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda = 0, ldb = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(comatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda = 100, ldb = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_dimatcopy.c b/utest/test_extensions/test_dimatcopy.c index 4debb50e8..d2a16bbbf 100644 --- a/utest/test_extensions/test_dimatcopy.c +++ b/utest/test_extensions/test_dimatcopy.c @@ -811,38 +811,6 @@ CTEST(dimatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(dimatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda_src = 0, lda_dst = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(dimatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda_src = 100, lda_dst = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda_src. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_domatcopy.c b/utest/test_extensions/test_domatcopy.c index f692e8784..e60b9c83d 100644 --- a/utest/test_extensions/test_domatcopy.c +++ b/utest/test_extensions/test_domatcopy.c @@ -536,38 +536,6 @@ CTEST(domatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(domatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda = 0, ldb = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(domatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda = 100, ldb = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_simatcopy.c b/utest/test_extensions/test_simatcopy.c index 0d9c44e73..cf14d360c 100644 --- a/utest/test_extensions/test_simatcopy.c +++ b/utest/test_extensions/test_simatcopy.c @@ -811,38 +811,6 @@ CTEST(simatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(simatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda_src = 0, lda_dst = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(simatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda_src = 100, lda_dst = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda_src. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_somatcopy.c b/utest/test_extensions/test_somatcopy.c index c75bbc75e..b53c7cae5 100644 --- a/utest/test_extensions/test_somatcopy.c +++ b/utest/test_extensions/test_somatcopy.c @@ -536,38 +536,6 @@ CTEST(somatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(somatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda = 0, ldb = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(somatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda = 100, ldb = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_zimatcopy.c b/utest/test_extensions/test_zimatcopy.c index 6461ce88f..8376bc493 100644 --- a/utest/test_extensions/test_zimatcopy.c +++ b/utest/test_extensions/test_zimatcopy.c @@ -714,38 +714,6 @@ CTEST(zimatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(zimatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda_src = 0, lda_dst = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(zimatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda_src = 100, lda_dst = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda_src. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_zomatcopy.c b/utest/test_extensions/test_zomatcopy.c index 8df3dd80f..495831c56 100644 --- a/utest/test_extensions/test_zomatcopy.c +++ b/utest/test_extensions/test_zomatcopy.c @@ -541,38 +541,6 @@ CTEST(zomatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** -* Test error function for an invalid param m. -* Must be positive. -*/ -CTEST(zomatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda = 0, ldb = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** -* Test error function for an invalid param n. -* Must be positive. -*/ -CTEST(zomatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda = 100, ldb = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda. * If matrices are stored using row major layout, From 441339104f5056ba8d68343667511de683d69ca6 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Fri, 2 Feb 2024 13:49:39 +0300 Subject: [PATCH 04/12] fix test ext cmake build --- utest/CMakeLists.txt | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/utest/CMakeLists.txt b/utest/CMakeLists.txt index d78701707..c090ed511 100644 --- a/utest/CMakeLists.txt +++ b/utest/CMakeLists.txt @@ -22,6 +22,7 @@ endif () set(DIR_EXT test_extensions) set(OpenBLAS_utest_ext_src utest_main.c +${DIR_EXT}/common.c ${DIR_EXT}/xerbla.c ${DIR_EXT}/test_isamin.c ${DIR_EXT}/test_idamin.c @@ -39,14 +40,14 @@ ${DIR_EXT}/test_scamax.c ${DIR_EXT}/test_dzamax.c ${DIR_EXT}/test_zrotg.c ${DIR_EXT}/test_crotg.c -$(DIR_EXT)/test_drotmg.c -$(DIR_EXT)/test_srotmg.c -$(DIR_EXT)/test_zscal.c -$(DIR_EXT)/test_cscal.c -$(DIR_EXT)/test_domatcopy.c -$(DIR_EXT)/test_somatcopy.c -$(DIR_EXT)/test_zomatcopy.c -$(DIR_EXT)/test_comatcopy.c +${DIR_EXT}/test_drotmg.c +${DIR_EXT}/test_srotmg.c +${DIR_EXT}/test_zscal.c +${DIR_EXT}/test_cscal.c +${DIR_EXT}/test_domatcopy.c +${DIR_EXT}/test_somatcopy.c +${DIR_EXT}/test_zomatcopy.c +${DIR_EXT}/test_comatcopy.c ${DIR_EXT}/test_simatcopy.c ${DIR_EXT}/test_dimatcopy.c ${DIR_EXT}/test_cimatcopy.c @@ -59,12 +60,12 @@ ${DIR_EXT}/test_saxpby.c ${DIR_EXT}/test_daxpby.c ${DIR_EXT}/test_caxpby.c ${DIR_EXT}/test_zaxpby.c -${DIR_EXT}/test_caxpyc.c -${DIR_EXT}/test_zaxpyc.c -$(DIR_EXT)/test_cgemv_t.c -$(DIR_EXT)/test_zgemv_t.c -$(DIR_EXT)/test_cgemv_n.c -$(DIR_EXT)/test_zgemv_n.c +# ${DIR_EXT}/test_caxpyc.c +# ${DIR_EXT}/test_zaxpyc.c +${DIR_EXT}/test_cgemv_t.c +${DIR_EXT}/test_zgemv_t.c +${DIR_EXT}/test_cgemv_n.c +${DIR_EXT}/test_zgemv_n.c ${DIR_EXT}/test_crot.c ${DIR_EXT}/test_zrot.c ${DIR_EXT}/test_cgbmv.c @@ -75,10 +76,10 @@ ${DIR_EXT}/test_cgemmt.c ${DIR_EXT}/test_zgemmt.c ${DIR_EXT}/test_ztrmv.c ${DIR_EXT}/test_ctrmv.c -$(DIR_EXT)/test_ztrsv.c -$(DIR_EXT)/test_ctrsv.c -$(DIR_EXT)/test_zgemm.c -$(DIR_EXT)/test_cgemm.c +${DIR_EXT}/test_ztrsv.c +${DIR_EXT}/test_ctrsv.c +${DIR_EXT}/test_zgemm.c +${DIR_EXT}/test_cgemm.c ) # crashing on travis cl with an error code suggesting resource not found From b6949ce74c8a22f4ec2b710ac084411f6b6560b0 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Fri, 2 Feb 2024 14:42:27 +0300 Subject: [PATCH 05/12] add axpyc to cmake build --- utest/CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/utest/CMakeLists.txt b/utest/CMakeLists.txt index c090ed511..67dc489d1 100644 --- a/utest/CMakeLists.txt +++ b/utest/CMakeLists.txt @@ -60,8 +60,8 @@ ${DIR_EXT}/test_saxpby.c ${DIR_EXT}/test_daxpby.c ${DIR_EXT}/test_caxpby.c ${DIR_EXT}/test_zaxpby.c -# ${DIR_EXT}/test_caxpyc.c -# ${DIR_EXT}/test_zaxpyc.c +${DIR_EXT}/test_caxpyc.c +${DIR_EXT}/test_zaxpyc.c ${DIR_EXT}/test_cgemv_t.c ${DIR_EXT}/test_zgemv_t.c ${DIR_EXT}/test_cgemv_n.c From ff10e6b6dc30e247eb0cabd00de610b48c615c91 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Thu, 8 Feb 2024 00:19:54 +0300 Subject: [PATCH 06/12] Fix zero step tests --- utest/test_extensions/test_damin.c | 4 ++-- utest/test_extensions/test_dzamax.c | 7 +++---- utest/test_extensions/test_dzamin.c | 6 +++--- utest/test_extensions/test_idamin.c | 4 ++-- utest/test_extensions/test_isamin.c | 4 ++-- utest/test_extensions/test_samin.c | 6 +++--- utest/test_extensions/test_scamax.c | 7 +++---- utest/test_extensions/test_scamin.c | 6 +++--- 8 files changed, 21 insertions(+), 23 deletions(-) diff --git a/utest/test_extensions/test_damin.c b/utest/test_extensions/test_damin.c index d492343ed..fdd2bc658 100644 --- a/utest/test_extensions/test_damin.c +++ b/utest/test_extensions/test_damin.c @@ -60,12 +60,12 @@ CTEST(damin, step_zero){ blasint i; blasint N = ELEMENTS, inc = 0; double x[ELEMENTS]; - for (i = 0; i < N * inc; i ++) { + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0; double amin = BLASFUNC(damin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(x[0], amin, DOUBLE_EPS); } /** diff --git a/utest/test_extensions/test_dzamax.c b/utest/test_extensions/test_dzamax.c index edea3de8f..bdb3a4f18 100644 --- a/utest/test_extensions/test_dzamax.c +++ b/utest/test_extensions/test_dzamax.c @@ -59,13 +59,12 @@ CTEST(dzamax, bad_args_N_0){ CTEST(dzamax, step_zero){ blasint i; blasint N = ELEMENTS * 2, inc = 0; - double x[ELEMENTS]; - for (i = 0; i < N * inc * 2; i ++) { + double x[ELEMENTS * 2]; + for (i = 0; i < N; i ++) { x[i] = i + 1000; } - x[8] = 0.0; double amax = BLASFUNC(dzamax)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(0.0, amax, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amax, DOUBLE_EPS); } /** diff --git a/utest/test_extensions/test_dzamin.c b/utest/test_extensions/test_dzamin.c index 916eede92..9fcf87b7b 100644 --- a/utest/test_extensions/test_dzamin.c +++ b/utest/test_extensions/test_dzamin.c @@ -59,13 +59,13 @@ CTEST(dzamin, bad_args_N_0){ CTEST(dzamin, step_zero){ blasint i; blasint N = ELEMENTS * 2, inc = 0; - double x[ELEMENTS]; - for (i = 0; i < N * inc * 2; i ++) { + double x[ELEMENTS * 2]; + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0; double amin = BLASFUNC(dzamin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amin, DOUBLE_EPS); } /** diff --git a/utest/test_extensions/test_idamin.c b/utest/test_extensions/test_idamin.c index 9f099f666..6a7ed9d1e 100644 --- a/utest/test_extensions/test_idamin.c +++ b/utest/test_extensions/test_idamin.c @@ -62,7 +62,7 @@ CTEST(idamin, step_zero){ blasint i; blasint N = ELEMENTS, inc = 0; double x[ELEMENTS]; - for (i = 0; i < N * inc; i ++) { + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0; @@ -435,7 +435,7 @@ CTEST(idamin, c_api_step_zero){ blasint i; blasint N = ELEMENTS, inc = 0; double x[ELEMENTS]; - for (i = 0; i < N * inc; i ++) { + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0; diff --git a/utest/test_extensions/test_isamin.c b/utest/test_extensions/test_isamin.c index df8dead07..4ff235b83 100644 --- a/utest/test_extensions/test_isamin.c +++ b/utest/test_extensions/test_isamin.c @@ -62,7 +62,7 @@ CTEST(isamin, step_zero){ blasint i; blasint N = ELEMENTS, inc = 0; float x[ELEMENTS]; - for (i = 0; i < N * inc; i ++) { + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0f; @@ -435,7 +435,7 @@ CTEST(isamin, c_api_step_zero){ blasint i; blasint N = ELEMENTS, inc = 0; float x[ELEMENTS]; - for (i = 0; i < N * inc; i ++) { + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0f; diff --git a/utest/test_extensions/test_samin.c b/utest/test_extensions/test_samin.c index 5c747a0f6..2e3a73797 100644 --- a/utest/test_extensions/test_samin.c +++ b/utest/test_extensions/test_samin.c @@ -60,12 +60,12 @@ CTEST(samin, step_zero){ blasint i; blasint N = ELEMENTS, inc = 0; float x[ELEMENTS]; - for (i = 0; i < N * inc; i ++) { + for (i = 0; i < N; i ++) { x[i] = i + 1000; } - x[8] = 0.0f; + x[8] = 0.0; float amin = BLASFUNC(samin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(x[0], amin, SINGLE_EPS); } /** diff --git a/utest/test_extensions/test_scamax.c b/utest/test_extensions/test_scamax.c index 39d7201ff..0f49ebfad 100644 --- a/utest/test_extensions/test_scamax.c +++ b/utest/test_extensions/test_scamax.c @@ -59,13 +59,12 @@ CTEST(scamax, bad_args_N_0){ CTEST(scamax, step_zero){ blasint i; blasint N = ELEMENTS * 2, inc = 0; - float x[ELEMENTS]; - for (i = 0; i < N * inc * 2; i ++) { + float x[ELEMENTS * 2]; + for (i = 0; i < N; i ++) { x[i] = i + 1000; } - x[8] = 0.0f; float amax = BLASFUNC(scamax)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(0.0f, amax, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amax, SINGLE_EPS); } /** diff --git a/utest/test_extensions/test_scamin.c b/utest/test_extensions/test_scamin.c index 4baa23184..0f0414a1c 100644 --- a/utest/test_extensions/test_scamin.c +++ b/utest/test_extensions/test_scamin.c @@ -59,13 +59,13 @@ CTEST(scamin, bad_args_N_0){ CTEST(scamin, step_zero){ blasint i; blasint N = ELEMENTS * 2, inc = 0; - float x[ELEMENTS]; - for (i = 0; i < N * inc * 2; i ++) { + float x[ELEMENTS * 2]; + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0f; float amin = BLASFUNC(scamin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amin, SINGLE_EPS); } /** From ec5cfe3bc8e7fb4fae09e961ea6169e01cd21fa3 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Thu, 8 Feb 2024 00:21:38 +0300 Subject: [PATCH 07/12] Fix invalid tests --- utest/test_extensions/test_cgeadd.c | 6 +++--- utest/test_extensions/test_dgeadd.c | 6 +++--- utest/test_extensions/test_dimatcopy.c | 8 ++++---- utest/test_extensions/test_sgeadd.c | 6 +++--- utest/test_extensions/test_simatcopy.c | 8 ++++---- utest/test_extensions/test_zgeadd.c | 6 +++--- 6 files changed, 20 insertions(+), 20 deletions(-) diff --git a/utest/test_extensions/test_cgeadd.c b/utest/test_extensions/test_cgeadd.c index 0cf6cbf87..9b87ad9f3 100644 --- a/utest/test_extensions/test_cgeadd.c +++ b/utest/test_extensions/test_cgeadd.c @@ -349,7 +349,7 @@ CTEST(cgeadd, xerbla_lda_invalid) blasint lda = INVALID; blasint ldc = 1; - int expected_info = 6; + int expected_info = 5; int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -682,7 +682,7 @@ CTEST(cgeadd, c_api_xerbla_n_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 1; + int expected_info = 2; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -730,7 +730,7 @@ CTEST(cgeadd, c_api_xerbla_m_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 2; + int expected_info = 1; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); diff --git a/utest/test_extensions/test_dgeadd.c b/utest/test_extensions/test_dgeadd.c index 4654c51a3..8f93a842e 100644 --- a/utest/test_extensions/test_dgeadd.c +++ b/utest/test_extensions/test_dgeadd.c @@ -346,7 +346,7 @@ CTEST(dgeadd, xerbla_lda_invalid) blasint lda = INVALID; blasint ldc = 1; - int expected_info = 6; + int expected_info = 5; int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -680,7 +680,7 @@ CTEST(dgeadd, c_api_xerbla_n_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 1; + int expected_info = 2; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -728,7 +728,7 @@ CTEST(dgeadd, c_api_xerbla_m_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 2; + int expected_info = 1; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); diff --git a/utest/test_extensions/test_dimatcopy.c b/utest/test_extensions/test_dimatcopy.c index d2a16bbbf..811c356b3 100644 --- a/utest/test_extensions/test_dimatcopy.c +++ b/utest/test_extensions/test_dimatcopy.c @@ -856,7 +856,7 @@ CTEST(dimatcopy, xerbla_rowmajor_notrans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'R'; char trans = 'N'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -873,7 +873,7 @@ CTEST(dimatcopy, xerbla_rowmajor_trans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'R'; char trans = 'T'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -890,7 +890,7 @@ CTEST(dimatcopy, xerbla_colmajor_notrans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'C'; char trans = 'N'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -907,7 +907,7 @@ CTEST(dimatcopy, xerbla_colmajor_trans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'C'; char trans = 'T'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); diff --git a/utest/test_extensions/test_sgeadd.c b/utest/test_extensions/test_sgeadd.c index b42ce9c0e..171132b9d 100644 --- a/utest/test_extensions/test_sgeadd.c +++ b/utest/test_extensions/test_sgeadd.c @@ -349,7 +349,7 @@ CTEST(sgeadd, xerbla_lda_invalid) blasint lda = INVALID; blasint ldc = 1; - int expected_info = 6; + int expected_info = 5; int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -682,7 +682,7 @@ CTEST(sgeadd, c_api_xerbla_n_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 1; + int expected_info = 2; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -730,7 +730,7 @@ CTEST(sgeadd, c_api_xerbla_m_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 2; + int expected_info = 1; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); diff --git a/utest/test_extensions/test_simatcopy.c b/utest/test_extensions/test_simatcopy.c index cf14d360c..ba388596d 100644 --- a/utest/test_extensions/test_simatcopy.c +++ b/utest/test_extensions/test_simatcopy.c @@ -856,7 +856,7 @@ CTEST(simatcopy, xerbla_rowmajor_notrans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'R'; char trans = 'N'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -873,7 +873,7 @@ CTEST(simatcopy, xerbla_rowmajor_trans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'R'; char trans = 'T'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -890,7 +890,7 @@ CTEST(simatcopy, xerbla_colmajor_notrans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'C'; char trans = 'N'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -907,7 +907,7 @@ CTEST(simatcopy, xerbla_colmajor_trans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'C'; char trans = 'T'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); diff --git a/utest/test_extensions/test_zgeadd.c b/utest/test_extensions/test_zgeadd.c index e50f86de0..7496ccf88 100644 --- a/utest/test_extensions/test_zgeadd.c +++ b/utest/test_extensions/test_zgeadd.c @@ -349,7 +349,7 @@ CTEST(zgeadd, xerbla_lda_invalid) blasint lda = INVALID; blasint ldc = 1; - int expected_info = 6; + int expected_info = 5; int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -682,7 +682,7 @@ CTEST(zgeadd, c_api_xerbla_n_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 1; + int expected_info = 2; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -730,7 +730,7 @@ CTEST(zgeadd, c_api_xerbla_m_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 2; + int expected_info = 1; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); From cfabc48190bb3ac1b5c6ace9ee560477394054c8 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Thu, 8 Feb 2024 00:22:15 +0300 Subject: [PATCH 08/12] Update rotg tests --- utest/test_extensions/test_crotg.c | 24 ++++++++++++------------ utest/test_extensions/test_zrotg.c | 16 ++++++++-------- 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/utest/test_extensions/test_crotg.c b/utest/test_extensions/test_crotg.c index 9db7dc7d3..84875ccf7 100644 --- a/utest/test_extensions/test_crotg.c +++ b/utest/test_extensions/test_crotg.c @@ -48,10 +48,10 @@ CTEST(crotg, zero_a) float sc; BLASFUNC(crotg)(sa, sb, &sc, ss); ASSERT_DBL_NEAR_TOL(0.0f, sc, SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0f, ss[0], SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0f, sa[0], SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0f, sa[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70711f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.70711f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, sa[1], SINGLE_EPS); } /** @@ -83,8 +83,8 @@ CTEST(crotg, zero_real) float ss[2]; float sc; BLASFUNC(crotg)(sa, sb, &sc, ss); - ASSERT_DBL_NEAR_TOL(0.7071f, sc, SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(0.7071f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70711f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70711f, ss[0], SINGLE_EPS); ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); ASSERT_DBL_NEAR_TOL(0.0f, sa[0], SINGLE_EPS); ASSERT_DBL_NEAR_TOL(1.41421f, sa[1], SINGLE_EPS); @@ -174,10 +174,10 @@ CTEST(crotg, c_api_zero_a) float sc; cblas_crotg(sa, sb, &sc, ss); ASSERT_DBL_NEAR_TOL(0.0f, sc, SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0f, ss[0], SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0f, sa[0], SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0f, sa[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70711f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.70711f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, sa[1], SINGLE_EPS); } /** @@ -209,8 +209,8 @@ CTEST(crotg, c_api_zero_real) float ss[2]; float sc; cblas_crotg(sa, sb, &sc, ss); - ASSERT_DBL_NEAR_TOL(0.7071f, sc, SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(0.7071f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70711f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70711f, ss[0], SINGLE_EPS); ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); ASSERT_DBL_NEAR_TOL(0.0f, sa[0], SINGLE_EPS); ASSERT_DBL_NEAR_TOL(1.41421f, sa[1], SINGLE_EPS); diff --git a/utest/test_extensions/test_zrotg.c b/utest/test_extensions/test_zrotg.c index 310121422..1de95447d 100644 --- a/utest/test_extensions/test_zrotg.c +++ b/utest/test_extensions/test_zrotg.c @@ -48,10 +48,10 @@ CTEST(zrotg, zero_a) double sc; BLASFUNC(zrotg)(sa, sb, &sc, ss); ASSERT_DBL_NEAR_TOL(0.0, sc, DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0, ss[0], DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0, sa[0], DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0, sa[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70710678118655, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.70710678118655, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421356237310, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, sa[1], DOUBLE_EPS); } /** @@ -174,10 +174,10 @@ CTEST(zrotg, c_api_zero_a) double sc; cblas_zrotg(sa, sb, &sc, ss); ASSERT_DBL_NEAR_TOL(0.0, sc, DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0, ss[0], DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0, sa[0], DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0, sa[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70710678118655, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.70710678118655, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421356237310, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, sa[1], DOUBLE_EPS); } /** From 4c554bd527cc3b8ed0c160cee457e23bfe442343 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Sat, 10 Feb 2024 00:46:52 +0300 Subject: [PATCH 09/12] check abs zero inc --- utest/test_extensions/test_damin.c | 4 ++-- utest/test_extensions/test_dzamax.c | 4 ++-- utest/test_extensions/test_dzamin.c | 4 ++-- utest/test_extensions/test_samin.c | 4 ++-- utest/test_extensions/test_scamax.c | 4 ++-- utest/test_extensions/test_scamin.c | 4 ++-- 6 files changed, 12 insertions(+), 12 deletions(-) diff --git a/utest/test_extensions/test_damin.c b/utest/test_extensions/test_damin.c index fdd2bc658..736921fa3 100644 --- a/utest/test_extensions/test_damin.c +++ b/utest/test_extensions/test_damin.c @@ -61,11 +61,11 @@ CTEST(damin, step_zero){ blasint N = ELEMENTS, inc = 0; double x[ELEMENTS]; for (i = 0; i < N; i ++) { - x[i] = i + 1000; + x[i] = i - 1000; } x[8] = 0.0; double amin = BLASFUNC(damin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(x[0], amin, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(fabs(x[0]), amin, DOUBLE_EPS); } /** diff --git a/utest/test_extensions/test_dzamax.c b/utest/test_extensions/test_dzamax.c index bdb3a4f18..7bc0200c9 100644 --- a/utest/test_extensions/test_dzamax.c +++ b/utest/test_extensions/test_dzamax.c @@ -61,10 +61,10 @@ CTEST(dzamax, step_zero){ blasint N = ELEMENTS * 2, inc = 0; double x[ELEMENTS * 2]; for (i = 0; i < N; i ++) { - x[i] = i + 1000; + x[i] = i - 1000; } double amax = BLASFUNC(dzamax)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amax, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL((fabs(x[0]) + fabs(x[1])), amax, DOUBLE_EPS); } /** diff --git a/utest/test_extensions/test_dzamin.c b/utest/test_extensions/test_dzamin.c index 9fcf87b7b..549881fdc 100644 --- a/utest/test_extensions/test_dzamin.c +++ b/utest/test_extensions/test_dzamin.c @@ -61,11 +61,11 @@ CTEST(dzamin, step_zero){ blasint N = ELEMENTS * 2, inc = 0; double x[ELEMENTS * 2]; for (i = 0; i < N; i ++) { - x[i] = i + 1000; + x[i] = i - 1000; } x[8] = 0.0; double amin = BLASFUNC(dzamin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amin, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL((fabs(x[0]) + fabs(x[1])), amin, DOUBLE_EPS); } /** diff --git a/utest/test_extensions/test_samin.c b/utest/test_extensions/test_samin.c index 2e3a73797..fd34d462a 100644 --- a/utest/test_extensions/test_samin.c +++ b/utest/test_extensions/test_samin.c @@ -61,11 +61,11 @@ CTEST(samin, step_zero){ blasint N = ELEMENTS, inc = 0; float x[ELEMENTS]; for (i = 0; i < N; i ++) { - x[i] = i + 1000; + x[i] = i - 1000; } x[8] = 0.0; float amin = BLASFUNC(samin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(x[0], amin, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(fabsf(x[0]), amin, SINGLE_EPS); } /** diff --git a/utest/test_extensions/test_scamax.c b/utest/test_extensions/test_scamax.c index 0f49ebfad..8c214ddff 100644 --- a/utest/test_extensions/test_scamax.c +++ b/utest/test_extensions/test_scamax.c @@ -61,10 +61,10 @@ CTEST(scamax, step_zero){ blasint N = ELEMENTS * 2, inc = 0; float x[ELEMENTS * 2]; for (i = 0; i < N; i ++) { - x[i] = i + 1000; + x[i] = i - 1000; } float amax = BLASFUNC(scamax)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amax, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL((fabsf(x[0]) + fabsf(x[1])), amax, SINGLE_EPS); } /** diff --git a/utest/test_extensions/test_scamin.c b/utest/test_extensions/test_scamin.c index 0f0414a1c..507548f2a 100644 --- a/utest/test_extensions/test_scamin.c +++ b/utest/test_extensions/test_scamin.c @@ -61,11 +61,11 @@ CTEST(scamin, step_zero){ blasint N = ELEMENTS * 2, inc = 0; float x[ELEMENTS * 2]; for (i = 0; i < N; i ++) { - x[i] = i + 1000; + x[i] = i - 1000; } x[8] = 0.0f; float amin = BLASFUNC(scamin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amin, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL((fabsf(x[0]) + fabsf(x[1])), amin, SINGLE_EPS); } /** From 5e9ead09ac03f27f7906576d4ec16cb80dc9fb4d Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Sat, 10 Feb 2024 00:47:25 +0300 Subject: [PATCH 10/12] fix info return --- interface/geadd.c | 4 ++-- interface/zgeadd.c | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/interface/geadd.c b/interface/geadd.c index 3a0ea015d..a2e6d1081 100644 --- a/interface/geadd.c +++ b/interface/geadd.c @@ -117,8 +117,8 @@ void CNAME(enum CBLAS_ORDER order, if (ldc < MAX(1, m)) info = 8; if (lda < MAX(1, m)) info = 5; - if (n < 0) info = 2; - if (m < 0) info = 1; + if (n < 0) info = 1; + if (m < 0) info = 2; } if (info >= 0) { diff --git a/interface/zgeadd.c b/interface/zgeadd.c index 7124cf230..de71f27b8 100644 --- a/interface/zgeadd.c +++ b/interface/zgeadd.c @@ -66,7 +66,7 @@ void NAME(blasint *M, blasint *N, FLOAT *ALPHA, FLOAT *a, blasint *LDA, info = 0; - if (lda < MAX(1, m)) info = 6; + if (lda < MAX(1, m)) info = 5; if (ldc < MAX(1, m)) info = 8; if (n < 0) info = 2; @@ -115,8 +115,8 @@ void CNAME(enum CBLAS_ORDER order, if (ldc < MAX(1, m)) info = 8; if (lda < MAX(1, m)) info = 5; - if (n < 0) info = 2; - if (m < 0) info = 1; + if (n < 0) info = 1; + if (m < 0) info = 2; } if (info >= 0) { From c6f30fd4146258dcdfc7cf1322ad1e0b4f88e1ac Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Sat, 10 Feb 2024 00:48:07 +0300 Subject: [PATCH 11/12] check for zero inc --- interface/max.c | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/interface/max.c b/interface/max.c index 6c7d32bd9..7817601b9 100644 --- a/interface/max.c +++ b/interface/max.c @@ -46,6 +46,12 @@ #ifdef USE_ABS +#if defined(DOUBLE) +#define ABS fabs +#else +#define ABS fabsf +#endif + #ifndef USE_MIN /* ABS & MAX */ @@ -92,6 +98,8 @@ #else +#define ABS + #ifndef USE_MIN /* MAX */ @@ -130,6 +138,12 @@ FLOATRET NAME(blasint *N, FLOAT *x, blasint *INCX){ if (n <= 0) return 0; +#ifndef COMPLEX + if (incx == 0) return (ABS(*x)); +#else + if (incx == 0) return (ABS(*x) + ABS(*(x+1))); +#endif + IDEBUG_START; FUNCTION_PROFILE_START(); @@ -158,6 +172,12 @@ FLOAT CNAME(blasint n, FLOAT *x, blasint incx){ if (n <= 0) return 0; +#ifndef COMPLEX + if (incx == 0) return (ABS(*x)); +#else + if (incx == 0) return (ABS(*x) + ABS(*(x+1))); +#endif + IDEBUG_START; FUNCTION_PROFILE_START(); From 7e9b1c08074d1e88f446fc5861f44c8844e93d30 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Sat, 10 Feb 2024 00:49:42 +0300 Subject: [PATCH 12/12] fix uninitialized data usage --- interface/zrotg.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/interface/zrotg.c b/interface/zrotg.c index ea73352dd..8acc3c9b2 100644 --- a/interface/zrotg.c +++ b/interface/zrotg.c @@ -102,7 +102,7 @@ void CNAME(void *VDA, void *VDB, FLOAT *C, void *VS) { if (ada >= h *safmin) { *C = sqrt(ada/h); *R = *DA / *C; - *(R+1) = *(DA+1) / *(C+1); + *(R+1) = *(DA+1) / *C; rtmax *= 2.; if ( ada > rtmin && h < rtmax) { // no risk of intermediate overflow *S = *S1 * (*DA / adahsq) - *(S1+1)* (*(DA+1)/adahsq); @@ -115,7 +115,7 @@ void CNAME(void *VDA, void *VDB, FLOAT *C, void *VS) { *C = ada / adahsq; if (*C >= safmin) { *R = *DA / *C; - *(R+1) = *(DA+1) / *(C+1); + *(R+1) = *(DA+1) / *C; } else { *R = *DA * (h / adahsq); *(R+1) = *(DA+1) * (h / adahsq);