floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #4499 from kseniyazaytseva/new-tests 

Tests for BLAS-like and BLAS API
This commit is contained in:
Martin Kroeker 2024-02-25 22:40:59 +01:00 committed by GitHub
parent 07e62a4619 7e9b1c0807
commit cb8131cfd9
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
70 changed files with 37157 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -47,6 +47,7 @@ config_last.h
getarch
getarch_2nd
utest/openblas_utest
utest/openblas_utest_ext
ctest/xccblat1
ctest/xccblat2
ctest/xccblat3

4
interface/geadd.c
View File

@ -117,8 +117,8 @@ void CNAME(enum CBLAS_ORDER order,
if (ldc < MAX(1, m)) info = 8;
if (lda < MAX(1, m)) info = 5;
if (n < 0) info = 2;
if (m < 0) info = 1;
if (n < 0) info = 1;
if (m < 0) info = 2;
}
if (info >= 0) {

20
interface/max.c
View File

@ -46,6 +46,12 @@
#ifdef USE_ABS
#if defined(DOUBLE)
#define ABS fabs
#else
#define ABS fabsf
#endif
#ifndef USE_MIN
/* ABS & MAX */
@ -92,6 +98,8 @@
#else
#define ABS
#ifndef USE_MIN
/* MAX */
@ -130,6 +138,12 @@ FLOATRET NAME(blasint *N, FLOAT *x, blasint *INCX){
if (n <= 0) return 0;
#ifndef COMPLEX
if (incx == 0) return (ABS(*x));
#else
if (incx == 0) return (ABS(*x) + ABS(*(x+1)));
#endif
IDEBUG_START;
FUNCTION_PROFILE_START();
@ -158,6 +172,12 @@ FLOAT CNAME(blasint n, FLOAT *x, blasint incx){
if (n <= 0) return 0;
#ifndef COMPLEX
if (incx == 0) return (ABS(*x));
#else
if (incx == 0) return (ABS(*x) + ABS(*(x+1)));
#endif
IDEBUG_START;
FUNCTION_PROFILE_START();

6
interface/zgeadd.c
View File

@ -66,7 +66,7 @@ void NAME(blasint *M, blasint *N, FLOAT *ALPHA, FLOAT *a, blasint *LDA,
info = 0;
if (lda < MAX(1, m)) info = 6;
if (lda < MAX(1, m)) info = 5;
if (ldc < MAX(1, m)) info = 8;
if (n < 0) info = 2;
@ -115,8 +115,8 @@ void CNAME(enum CBLAS_ORDER order,
if (ldc < MAX(1, m)) info = 8;
if (lda < MAX(1, m)) info = 5;
if (n < 0) info = 2;
if (m < 0) info = 1;
if (n < 0) info = 1;
if (m < 0) info = 2;
}
if (info >= 0) {

4
interface/zrotg.c
View File

@ -102,7 +102,7 @@ void CNAME(void *VDA, void *VDB, FLOAT *C, void *VS) {
if (ada >= h *safmin) {
*C = sqrt(ada/h);
*R = *DA / *C;
*(R+1) = *(DA+1) / *(C+1);
*(R+1) = *(DA+1) / *C;
rtmax *= 2.;
if ( ada > rtmin && h < rtmax) { // no risk of intermediate overflow
*S = *S1 * (*DA / adahsq) - *(S1+1)* (*(DA+1)/adahsq);
@ -115,7 +115,7 @@ void CNAME(void *VDA, void *VDB, FLOAT *C, void *VS) {
*C = ada / adahsq;
if (*C >= safmin) {
*R = *DA / *C;
*(R+1) = *(DA+1) / *(C+1);
*(R+1) = *(DA+1) / *C;
} else {
*R = *DA * (h / adahsq);
*(R+1) = *(DA+1) * (h / adahsq);

76
utest/CMakeLists.txt
View File

@ -21,6 +21,70 @@ else ()
)
endif ()
set(DIR_EXT test_extensions)
set(OpenBLAS_utest_ext_src
utest_main.c
${DIR_EXT}/common.c
${DIR_EXT}/xerbla.c
${DIR_EXT}/test_isamin.c
${DIR_EXT}/test_idamin.c
${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
@ -49,6 +113,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}
@ -60,7 +131,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)
@ -85,3 +160,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})

30
utest/Makefile
View File

@ -1,22 +1,39 @@
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_zscal.o \
test_amin.o test_axpby.o
#test_rot.o test_swap.o test_axpy.o test_dotu.o test_dsdot.o test_fork.o
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
@ -58,12 +75,17 @@ $(UTESTBIN): $(OBJS)
$(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) $(FEXTRALIB)
endif
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:

259
utest/test_extensions/common.c Normal file
View File

@ -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;
}
void drand_generate(double *alpha, blasint n)
{
blasint i;
for (i = 0; i < n; i++)
alpha[i] = (double)rand() / (double)RAND_MAX;
}
/**
* 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];
}
}
}

76
utest/test_extensions/common.h Normal file
View File

@ -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

631
utest/test_extensions/test_caxpby.c Normal file
View File

@ -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

158
utest/test_extensions/test_caxpyc.c Normal file
View File

@ -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

279
utest/test_extensions/test_cgbmv.c Normal file
View File

@ -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

880
utest/test_extensions/test_cgeadd.c Normal file
View File

@ -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 = 5;
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 = 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 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 = 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 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

273
utest/test_extensions/test_cgemm.c Normal file
View File

@ -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

2010
utest/test_extensions/test_cgemmt.c Normal file
View File

File diff suppressed because it is too large Load Diff

340
utest/test_extensions/test_cgemv_n.c Normal file
View File

@ -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

1132
utest/test_extensions/test_cgemv_t.c Normal file
View File

File diff suppressed because it is too large Load Diff

818
utest/test_extensions/test_cimatcopy.c Normal file
View File

@ -0,0 +1,818 @@
/*****************************************************************************
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 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

696
utest/test_extensions/test_comatcopy.c Normal file
View File

@ -0,0 +1,696 @@
/*****************************************************************************
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 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

792
utest/test_extensions/test_crot.c Normal file
View File

@ -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

290
utest/test_extensions/test_crotg.c Normal file
View File

@ -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(0.70711f, ss[0], SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(-0.70711f, ss[1], SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(1.41421f, sa[0], SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(0.0f, sa[1], SINGLE_EPS);
}
/**
* 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.70711f, sc, SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(0.70711f, ss[0], SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(0.0f, sa[0], SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(1.41421f, sa[1], SINGLE_EPS);
}
/**
* 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(0.70711f, ss[0], SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(-0.70711f, ss[1], SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(1.41421f, sa[0], SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(0.0f, sa[1], SINGLE_EPS);
}
/**
* 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.70711f, sc, SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(0.70711f, ss[0], SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(0.0f, sa[0], SINGLE_EPS);
ASSERT_DBL_NEAR_TOL(1.41421f, sa[1], SINGLE_EPS);
}
/**
* 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

606
utest/test_extensions/test_csbmv.c Normal file
View File

@ -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

164
utest/test_extensions/test_cscal.c Normal file
View File

@ -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

428
utest/test_extensions/test_cspmv.c Normal file
View File

@ -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

266
utest/test_extensions/test_ctrmv.c Normal file
View File

@ -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

267
utest/test_extensions/test_ctrsv.c Normal file
View File

@ -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

354
utest/test_extensions/test_damin.c Normal file
View File

@ -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; i ++) {
x[i] = i - 1000;
}
x[8] = 0.0;
double amin = BLASFUNC(damin)(&N, x, &inc);
ASSERT_DBL_NEAR_TOL(fabs(x[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

799
utest/test_extensions/test_daxpby.c Normal file
View File

@ -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

878
utest/test_extensions/test_dgeadd.c Normal file
View File

@ -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 = 5;
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 = 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 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 = 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 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

1442
utest/test_extensions/test_dgemmt.c Normal file
View File

File diff suppressed because it is too large Load Diff

915
utest/test_extensions/test_dimatcopy.c Normal file
View File

@ -0,0 +1,915 @@
/*****************************************************************************
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 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 = 8;
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 = 8;
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 = 8;
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 = 8;
int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info);
ASSERT_EQUAL(TRUE, passed);
}
#endif

640
utest/test_extensions/test_domatcopy.c Normal file
View File

@ -0,0 +1,640 @@
/*****************************************************************************
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 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

414
utest/test_extensions/test_drotmg.c Normal file
View File

@ -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

403
utest/test_extensions/test_dsum.c Normal file
View File

@ -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

293
utest/test_extensions/test_dzamax.c Normal file
View File

@ -0,0 +1,293 @@
/*****************************************************************************
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 * 2];
for (i = 0; i < N; i ++) {
x[i] = i - 1000;
}
double amax = BLASFUNC(dzamax)(&N, x, &inc);
ASSERT_DBL_NEAR_TOL((fabs(x[0]) + fabs(x[1])), 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

310
utest/test_extensions/test_dzamin.c Normal file
View File

@ -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 * 2];
for (i = 0; i < N; i ++) {
x[i] = i - 1000;
}
x[8] = 0.0;
double amin = BLASFUNC(dzamin)(&N, x, &inc);
ASSERT_DBL_NEAR_TOL((fabs(x[0]) + fabs(x[1])), 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

403
utest/test_extensions/test_dzsum.c Normal file
View File

@ -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

625
utest/test_extensions/test_icamin.c Normal file
View File

@ -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

787
utest/test_extensions/test_idamin.c Normal file
View File

@ -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; 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; 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

787
utest/test_extensions/test_isamin.c Normal file
View File

@ -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; 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; 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

625
utest/test_extensions/test_izamin.c Normal file
View File

@ -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

354
utest/test_extensions/test_samin.c Normal file
View File

@ -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; i ++) {
x[i] = i - 1000;
}
x[8] = 0.0;
float amin = BLASFUNC(samin)(&N, x, &inc);
ASSERT_DBL_NEAR_TOL(fabsf(x[0]), 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

794
utest/test_extensions/test_saxpby.c Normal file
View File

@ -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

293
utest/test_extensions/test_scamax.c Normal file
View File

@ -0,0 +1,293 @@
/*****************************************************************************
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 * 2];
for (i = 0; i < N; i ++) {
x[i] = i - 1000;
}
float amax = BLASFUNC(scamax)(&N, x, &inc);
ASSERT_DBL_NEAR_TOL((fabsf(x[0]) + fabsf(x[1])), 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

310
utest/test_extensions/test_scamin.c Normal file
View File

@ -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 * 2];
for (i = 0; i < N; i ++) {
x[i] = i - 1000;
}
x[8] = 0.0f;
float amin = BLASFUNC(scamin)(&N, x, &inc);
ASSERT_DBL_NEAR_TOL((fabsf(x[0]) + fabsf(x[1])), 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

403
utest/test_extensions/test_scsum.c Normal file
View File

@ -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

880
utest/test_extensions/test_sgeadd.c Normal file
View File

@ -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 = 5;
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 = 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 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 = 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 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

1442
utest/test_extensions/test_sgemmt.c Normal file
View File

File diff suppressed because it is too large Load Diff

915
utest/test_extensions/test_simatcopy.c Normal file
View File

@ -0,0 +1,915 @@
/*****************************************************************************
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 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 = 8;
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 = 8;
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 = 8;
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 = 8;
int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info);
ASSERT_EQUAL(TRUE, passed);
}
#endif

640
utest/test_extensions/test_somatcopy.c Normal file
View File

@ -0,0 +1,640 @@
/*****************************************************************************
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 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

414
utest/test_extensions/test_srotmg.c Normal file
View File

@ -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

403
utest/test_extensions/test_ssum.c Normal file
View File

@ -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

630
utest/test_extensions/test_zaxpby.c Normal file
View File

@ -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

159
utest/test_extensions/test_zaxpyc.c Normal file
View File

@ -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

280
utest/test_extensions/test_zgbmv.c Normal file
View File

@ -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

880
utest/test_extensions/test_zgeadd.c Normal file
View File

@ -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
drand_generate(data_zgeadd.a_test, lda * rows * 2);
drand_generate(data_zgeadd.c_test, ldc * rows * 2);
// Copy matrix C for zgeadd
for (i = 0; i < ldc * rows * 2; i++)
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 = 5;
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 = 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 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 = 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 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

273
utest/test_extensions/test_zgemm.c Normal file
View File

@ -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

2010
utest/test_extensions/test_zgemmt.c Normal file
View File

File diff suppressed because it is too large Load Diff

341
utest/test_extensions/test_zgemv_n.c Normal file
View File

@ -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

1136
utest/test_extensions/test_zgemv_t.c Normal file
View File

File diff suppressed because it is too large Load Diff

818
utest/test_extensions/test_zimatcopy.c Normal file
View File

@ -0,0 +1,818 @@
/*****************************************************************************
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 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

713
utest/test_extensions/test_zomatcopy.c Normal file
View File

@ -0,0 +1,713 @@
/*****************************************************************************
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 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

790
utest/test_extensions/test_zrot.c Normal file
View File

@ -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

290
utest/test_extensions/test_zrotg.c Normal file
View File

@ -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(0.70710678118655, ss[0], DOUBLE_EPS);
ASSERT_DBL_NEAR_TOL(-0.70710678118655, ss[1], DOUBLE_EPS);
ASSERT_DBL_NEAR_TOL(1.41421356237310, sa[0], DOUBLE_EPS);
ASSERT_DBL_NEAR_TOL(0.0, sa[1], DOUBLE_EPS);
}
/**
* 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(0.70710678118655, ss[0], DOUBLE_EPS);
ASSERT_DBL_NEAR_TOL(-0.70710678118655, ss[1], DOUBLE_EPS);
ASSERT_DBL_NEAR_TOL(1.41421356237310, sa[0], DOUBLE_EPS);
ASSERT_DBL_NEAR_TOL(0.0, sa[1], DOUBLE_EPS);
}
/**
* 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

606
utest/test_extensions/test_zsbmv.c Normal file
View File

@ -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

165
utest/test_extensions/test_zscal.c Normal file
View File

@ -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

427
utest/test_extensions/test_zspmv.c Normal file
View File

@ -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

266
utest/test_extensions/test_ztrmv.c Normal file
View File

@ -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;
drand_generate(data_ztrmv.a_test, n * lda * 2);
drand_generate(data_ztrmv.x_test, n * incx * 2);
for (i = 0; i < n * lda * 2; i++)
data_ztrmv.a_verify[i] = data_ztrmv.a_test[i];
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

267
utest/test_extensions/test_ztrsv.c Normal file
View File

@ -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;
drand_generate(data_ztrsv.a_test, n * lda * 2);
drand_generate(data_ztrsv.x_test, n * incx * 2);
for (i = 0; i < n * lda * 2; i++)
data_ztrsv.a_verify[i] = data_ztrsv.a_test[i];
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

88
utest/test_extensions/xerbla.c Normal file
View File

@ -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;
}