| @@ -46,6 +46,7 @@ config_last.h | |||
| getarch | |||
| getarch_2nd | |||
| utest/openblas_utest | |||
| utest/openblas_utest_ext | |||
| ctest/xccblat1 | |||
| ctest/xccblat2 | |||
| ctest/xccblat3 | |||
| @@ -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}) | |||
| @@ -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: | |||
| @@ -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]; | |||
| } | |||
| } | |||
| } | |||
| @@ -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 <cblas.h> | |||
| #include <ctype.h> | |||
| #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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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 <cblas.h> | |||
| #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 | |||
| @@ -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; | |||
| } | |||