From 4b9693f8f11e66c9c1eb130acfbfcecad27295fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Mon, 26 Aug 2024 09:48:17 +0200 Subject: [PATCH] Add CBLAS for AXPBY --- CBLAS/include/cblas_f77.h | 10 +++--- CBLAS/src/CMakeLists.txt | 8 ++--- CBLAS/src/Makefile | 8 ++--- CBLAS/src/cblas_caxpby.c | 22 +++++++++++++ CBLAS/src/cblas_daxpby.c | 22 +++++++++++++ CBLAS/src/cblas_saxpby.c | 23 +++++++++++++ CBLAS/src/cblas_zaxpby.c | 22 +++++++++++++ CBLAS/testing/c_cblas1.c | 8 +++++ CBLAS/testing/c_cblat1.f | 69 +++++++++++++++++++++++++++++++++++---- CBLAS/testing/c_dblas1.c | 8 +++++ CBLAS/testing/c_dblat1.f | 43 +++++++++++++++++++++--- CBLAS/testing/c_sblas1.c | 8 +++++ CBLAS/testing/c_sblat1.f | 41 ++++++++++++++++++++--- CBLAS/testing/c_zblas1.c | 8 +++++ CBLAS/testing/c_zblat1.f | 66 ++++++++++++++++++++++++++++++++++--- 15 files changed, 332 insertions(+), 34 deletions(-) create mode 100644 CBLAS/src/cblas_caxpby.c create mode 100644 CBLAS/src/cblas_daxpby.c create mode 100644 CBLAS/src/cblas_saxpby.c create mode 100644 CBLAS/src/cblas_zaxpby.c diff --git a/CBLAS/include/cblas_f77.h b/CBLAS/include/cblas_f77.h index 2cff1a8fc1..a251f3079d 100644 --- a/CBLAS/include/cblas_f77.h +++ b/CBLAS/include/cblas_f77.h @@ -243,7 +243,7 @@ #define F77_sswap(...) F77_sswap_base(__VA_ARGS__) #define F77_scopy(...) F77_scopy_base(__VA_ARGS__) #define F77_saxpy(...) F77_saxpy_base(__VA_ARGS__) -#define F77_saxpby(...) F77_saxpby_base(__VA_ARGS__) +#define F77_saxpby(...) F77_saxpby_base(__VA_ARGS__) #define F77_sdot_sub(...) F77_sdot_sub_base(__VA_ARGS__) #define F77_sdsdot_sub(...) F77_sdsdot_sub_base(__VA_ARGS__) #define F77_sscal(...) F77_sscal_base(__VA_ARGS__) @@ -610,7 +610,7 @@ void F77_srotmg_base(float *,float *,float *,const float *, float *); void F77_sswap_base(FINT, float *, FINT, float *, FINT); void F77_scopy_base(FINT, const float *, FINT, float *, FINT); void F77_saxpy_base(FINT, const float *, const float *, FINT, float *, FINT); -void F77_saxpy_base(FINT, const float *, const float *, FINT, float *, float *, FINT); +void F77_saxpby_base(FINT, const float *, const float *, FINT, const float *, float *, FINT); void F77_sdot_sub_base(FINT, const float *, FINT, const float *, FINT, float *); void F77_sdsdot_sub_base(FINT, const float *, const float *, FINT, const float *, FINT, float *); void F77_sscal_base(FINT, const float *, float *, FINT); @@ -627,7 +627,7 @@ void F77_drotmg_base(double *,double *,double *,const double *, double *); void F77_dswap_base(FINT, double *, FINT, double *, FINT); void F77_dcopy_base(FINT, const double *, FINT, double *, FINT); void F77_daxpy_base(FINT, const double *, const double *, FINT, double *, FINT); -void F77_daxpby_base(FINT, const double *, const double *, FINT, double *, double *, FINT); +void F77_daxpby_base(FINT, const double *, const double *, FINT, const double *, double *, FINT); void F77_dswap_base(FINT, double *, FINT, double *, FINT); void F77_dsdot_sub_base(FINT, const float *, FINT, const float *, FINT, double *); void F77_ddot_sub_base(FINT, const double *, FINT, const double *, FINT, double *); @@ -643,7 +643,7 @@ void F77_csrot_base(FINT, void *X, FINT, void *, FINT, const float *, const floa void F77_cswap_base(FINT, void *, FINT, void *, FINT); void F77_ccopy_base(FINT, const void *, FINT, void *, FINT); void F77_caxpy_base(FINT, const void *, const void *, FINT, void *, FINT); -void F77_caxpby_base(FINT, const void *, const void *, FINT, void *, void *, FINT); +void F77_caxpby_base(FINT, const void *, const void *, FINT, const void *, void *, FINT); void F77_cswap_base(FINT, void *, FINT, void *, FINT); void F77_cdotc_sub_base(FINT, const void *, FINT, const void *, FINT, void *); void F77_cdotu_sub_base(FINT, const void *, FINT, const void *, FINT, void *); @@ -661,7 +661,7 @@ void F77_zdrot_base(FINT, void *X, FINT, void *, FINT, const double *, const dou void F77_zswap_base(FINT, void *, FINT, void *, FINT); void F77_zcopy_base(FINT, const void *, FINT, void *, FINT); void F77_zaxpy_base(FINT, const void *, const void *, FINT, void *, FINT); -void F77_zaxpby_base(FINT, const void *, const void *, FINT, void*, void *, FINT); +void F77_zaxpby_base(FINT, const void *, const void *, FINT, const void*, void *, FINT); void F77_zswap_base(FINT, void *, FINT, void *, FINT); void F77_zdotc_sub_base(FINT, const void *, FINT, const void *, FINT, void *); void F77_zdotu_sub_base(FINT, const void *, FINT, const void *, FINT, void *); diff --git a/CBLAS/src/CMakeLists.txt b/CBLAS/src/CMakeLists.txt index 8dcb2f2931..87bc076867 100644 --- a/CBLAS/src/CMakeLists.txt +++ b/CBLAS/src/CMakeLists.txt @@ -16,21 +16,21 @@ set(SLEV1 cblas_srotg.c cblas_srotmg.c cblas_srot.c cblas_srotm.c cblas_sswap.c cblas_sscal.c cblas_scopy.c cblas_saxpy.c cblas_sdot.c cblas_sdsdot.c cblas_snrm2.c cblas_sasum.c cblas_isamax.c sdotsub.f sdsdotsub.f snrm2sub.f sasumsub.f - isamaxsub.f) + isamaxsub.f cblas_saxpby.c) # Files for level 1 double precision real set(DLEV1 cblas_drotg.c cblas_drotmg.c cblas_drot.c cblas_drotm.c cblas_dswap.c cblas_dscal.c cblas_dcopy.c cblas_daxpy.c cblas_ddot.c cblas_dsdot.c cblas_dnrm2.c cblas_dasum.c cblas_idamax.c ddotsub.f dsdotsub.f dnrm2sub.f - dasumsub.f idamaxsub.f) + dasumsub.f idamaxsub.f cblas_daxpby.c) # Files for level 1 single precision complex set(CLEV1 cblas_crotg.c cblas_csrot.c cblas_cswap.c cblas_cscal.c cblas_csscal.c cblas_ccopy.c cblas_caxpy.c cblas_cdotu_sub.c cblas_cdotc_sub.c cblas_icamax.c cdotcsub.f cdotusub.f icamaxsub.f - cblas_scabs1.c scabs1sub.f ) + cblas_scabs1.c scabs1sub.f cblas_caxpby.c) # Files for level 1 double precision complex set(ZLEV1 cblas_zrotg.c cblas_zdrot.c @@ -38,7 +38,7 @@ set(ZLEV1 cblas_zrotg.c cblas_zdrot.c cblas_zaxpy.c cblas_zdotu_sub.c cblas_zdotc_sub.c cblas_dznrm2.c cblas_dzasum.c cblas_izamax.c zdotcsub.f zdotusub.f dzasumsub.f dznrm2sub.f izamaxsub.f - cblas_dcabs1.c dcabs1sub.f) + cblas_dcabs1.c dcabs1sub.f cblas_zaxpby.c) # Common files for level 1 single precision set(SCLEV1 cblas_scasum.c scasumsub.f cblas_scnrm2.c scnrm2sub.f) diff --git a/CBLAS/src/Makefile b/CBLAS/src/Makefile index abc3192c6a..9583a08447 100644 --- a/CBLAS/src/Makefile +++ b/CBLAS/src/Makefile @@ -26,21 +26,21 @@ slev1 = cblas_srotg.o cblas_srotmg.o cblas_srot.o cblas_srotm.o \ cblas_sswap.o cblas_sscal.o cblas_scopy.o cblas_saxpy.o \ cblas_sdot.o cblas_sdsdot.o cblas_snrm2.o cblas_sasum.o \ cblas_isamax.o sdotsub.o sdsdotsub.o snrm2sub.o sasumsub.o \ - isamaxsub.o + isamaxsub.o cblas_saxpby.o # Files for level 1 double precision real dlev1 = cblas_drotg.o cblas_drotmg.o cblas_drot.o cblas_drotm.o \ cblas_dswap.o cblas_dscal.o cblas_dcopy.o cblas_daxpy.o \ cblas_ddot.o cblas_dsdot.o cblas_dnrm2.o cblas_dasum.o \ cblas_idamax.o ddotsub.o dsdotsub.o dnrm2sub.o \ - dasumsub.o idamaxsub.o + dasumsub.o idamaxsub.o cblas_daxpby.o # Files for level 1 single precision complex clev1 = cblas_crotg.o cblas_csrot.o \ cblas_cswap.o cblas_cscal.o cblas_csscal.o cblas_ccopy.o \ cblas_caxpy.o cblas_cdotu_sub.o cblas_cdotc_sub.o \ cblas_icamax.o cdotcsub.o cdotusub.o icamaxsub.o \ - cblas_scabs1.o scabs1sub.o + cblas_scabs1.o scabs1sub.o cblas_caxpby.o # Files for level 1 double precision complex zlev1 = cblas_zrotg.o cblas_zdrot.o \ @@ -48,7 +48,7 @@ zlev1 = cblas_zrotg.o cblas_zdrot.o \ cblas_zaxpy.o cblas_zdotu_sub.o cblas_zdotc_sub.o cblas_dznrm2.o \ cblas_dzasum.o cblas_izamax.o zdotcsub.o zdotusub.o \ dzasumsub.o dznrm2sub.o izamaxsub.o \ - cblas_dcabs1.o dcabs1sub.o + cblas_dcabs1.o dcabs1sub.o cblas_zaxpby.o # Common files for level 1 single precision sclev1 = cblas_scasum.o scasumsub.o cblas_scnrm2.o scnrm2sub.o diff --git a/CBLAS/src/cblas_caxpby.c b/CBLAS/src/cblas_caxpby.c new file mode 100644 index 0000000000..997ba3c952 --- /dev/null +++ b/CBLAS/src/cblas_caxpby.c @@ -0,0 +1,22 @@ +/* + * cblas_caxpby.c + * + * The program is a C interface to caxpby. + * + * Written by Martin Koehler. 08/26/2024 + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_caxpby)( const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_caxpby( &F77_N, alpha, X, &F77_incX, beta, Y, &F77_incY); +} diff --git a/CBLAS/src/cblas_daxpby.c b/CBLAS/src/cblas_daxpby.c new file mode 100644 index 0000000000..a4df635247 --- /dev/null +++ b/CBLAS/src/cblas_daxpby.c @@ -0,0 +1,22 @@ +/* + * cblas_daxpby.c + * + * The program is a C interface to daxpby. + * + * Written by Martin Koehler. 08/26/2024 + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_daxpby)( const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, const double beta, double *Y, const CBLAS_INT incY) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_daxpby( &F77_N, &alpha, X, &F77_incX, &beta, Y, &F77_incY); +} diff --git a/CBLAS/src/cblas_saxpby.c b/CBLAS/src/cblas_saxpby.c new file mode 100644 index 0000000000..b8e025d766 --- /dev/null +++ b/CBLAS/src/cblas_saxpby.c @@ -0,0 +1,23 @@ +/* + * cblas_saxpby.c + * + * The program is a C interface to saxpby. + * It calls the fortran wrapper before calling saxpby. + * + * Written by Martin Koehler, 08/24/2024 + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_saxpby)( const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float beta, float *Y, const CBLAS_INT incY) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_saxpby( &F77_N, &alpha, X, &F77_incX, &beta, Y, &F77_incY); +} diff --git a/CBLAS/src/cblas_zaxpby.c b/CBLAS/src/cblas_zaxpby.c new file mode 100644 index 0000000000..3aebecac8b --- /dev/null +++ b/CBLAS/src/cblas_zaxpby.c @@ -0,0 +1,22 @@ +/* + * cblas_zaxpby.c + * + * The program is a C interface to zaxpby. + * + * Written by Martin Koehler, 08/26/2024 + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_zaxpby)( const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_zaxpby( &F77_N, alpha, X, &F77_incX, beta, Y, &F77_incY); +} diff --git a/CBLAS/testing/c_cblas1.c b/CBLAS/testing/c_cblas1.c index 75b5b73836..ddfd84490a 100644 --- a/CBLAS/testing/c_cblas1.c +++ b/CBLAS/testing/c_cblas1.c @@ -15,6 +15,14 @@ void F77_caxpy(const CBLAS_INT *N, const void *alpha, void *X, return; } +void F77_caxpby(const CBLAS_INT *N, const void *alpha, void *X, + const CBLAS_INT *incX, const void *beta, void *Y, const CBLAS_INT *incY) +{ + cblas_caxpby(*N, alpha, X, *incX, beta, Y, *incY); + return; +} + + void F77_ccopy(const CBLAS_INT *N, void *X, const CBLAS_INT *incX, void *Y, const CBLAS_INT *incY) { diff --git a/CBLAS/testing/c_cblat1.f b/CBLAS/testing/c_cblat1.f index 1a123d74dc..c060af6417 100644 --- a/CBLAS/testing/c_cblat1.f +++ b/CBLAS/testing/c_cblat1.f @@ -19,7 +19,7 @@ PROGRAM CCBLAT1 DATA SFAC/9.765625E-4/ * .. Executable Statements .. WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -32,7 +32,7 @@ PROGRAM CCBLAT1 INCX = 9999 INCY = 9999 MODE = 9999 - IF (ICASE.LE.5) THEN + IF (ICASE.LE.5 .OR. ICASE.EQ.11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.GE.6) THEN CALL CHECK1(SFAC) @@ -53,7 +53,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*15 L(10) + CHARACTER*15 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. @@ -67,6 +67,8 @@ SUBROUTINE HEADER DATA L(8)/'CBLAS_CSCAL'/ DATA L(9)/'CBLAS_CSSCAL'/ DATA L(10)/'CBLAS_ICAMAX'/ + DATA L(11)/'CBLAS_CAXPBY'/ + * .. Executable Statements .. WRITE (NOUT,99999) ICASE, L(ICASE) RETURN @@ -284,23 +286,26 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - COMPLEX CA,CTEMP + COMPLEX CA,CB,CTEMP INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY * .. Local Arrays .. COMPLEX CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14), + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4), - + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7) + + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7), + + CT11(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. EXTERNAL CDOTCTEST, CDOTUTEST * .. External Subroutines .. - EXTERNAL CAXPYTEST, CCOPYTEST, CSWAPTEST, CTEST + EXTERNAL CAXPYTEST, CCOPYTEST, CSWAPTEST, CTEST, + + CAXPBYTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA CA/(0.4E0,-0.7E0)/ + DATA CB/(0.7E0,-0.4E0)/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -470,6 +475,54 @@ SUBROUTINE CHECK2(SFAC) + (1.54E0,1.54E0), (1.54E0,1.54E0), + (1.54E0,1.54E0), (1.54E0,1.54E0), + (1.54E0,1.54E0), (1.54E0,1.54E0)/ + + DATA ((CT11(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.1E0,-1.47E0), + + (-1.08E0,0.71E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (-1.08E0,0.71E0), + + (-0.42E0,-0.99E0), (-0.61E0,-0.85E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ + DATA ((CT11(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.49E0,-0.95E0), + + (-0.9E0,0.5E0),(-0.03E0,-1.51E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.36E0,0.00E0), (-0.9E0,0.5E0), + + (-0.39E0,-0.23E0), (0.1E0,-0.5E0), + + (-0.82E0,-0.39E0), (-0.5E0,-0.3E0), + + (0.0E0,-1.62E0)/ + DATA ((CT11(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.49E0,-0.95E0), + + (-0.71E0,-0.1E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.36E0,0.00E0), (-1.07E0,1.18E0), + + (-0.42E0,-0.99E0), (-0.41E0,-1.2E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ + DATA ((CT11(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.1E0,-1.47E0), (-0.9E0,0.5E0), + + (-0.4E0,-0.7E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.1E0,-1.47E0), + + (-0.9E0,0.5E0),(-0.4E0,-0.7E0), (0.1E0,-0.5E0), + + (-0.82E0,-0.39E0), (-0.5E0,-0.3E0), + + (-0.2E0,-1.27E0)/ + + * .. Executable Statements .. DO 60 KI = 1, 4 INCX = INCXS(KI) @@ -510,6 +563,10 @@ SUBROUTINE CHECK2(SFAC) CALL CSWAPTEST(N,CX,INCX,CY,INCY) CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0E0) CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0) + ELSE IF (ICASE.EQ.11) THEN +* .. CAXPBYTEST .. + CALL CAXPBYTEST(N,CA,CX,INCX,CB,CY,INCY) + CALL CTEST(LENY,CY,CT11(1,KN,KI),CSIZE2(1,KSIZE),SFAC) ELSE WRITE (NOUT,*) ' Shouldn''t be here in CHECK2' STOP diff --git a/CBLAS/testing/c_dblas1.c b/CBLAS/testing/c_dblas1.c index cf03549fa8..ee120af594 100644 --- a/CBLAS/testing/c_dblas1.c +++ b/CBLAS/testing/c_dblas1.c @@ -20,6 +20,14 @@ void F77_daxpy(const CBLAS_INT *N, const double *alpha, const double *X, return; } +void F77_daxpby(const CBLAS_INT *N, const double *alpha, const double *X, + const CBLAS_INT *incX, const double *beta, double *Y, const CBLAS_INT *incY) +{ + cblas_daxpby(*N, *alpha, X, *incX, *beta, Y, *incY); + return; +} + + void F77_dcopy(const CBLAS_INT *N, double *X, const CBLAS_INT *incX, double *Y, const CBLAS_INT *incY) { diff --git a/CBLAS/testing/c_dblat1.f b/CBLAS/testing/c_dblat1.f index 4a71b4dcf7..cda3813e04 100644 --- a/CBLAS/testing/c_dblat1.f +++ b/CBLAS/testing/c_dblat1.f @@ -19,7 +19,7 @@ PROGRAM DCBLAT1 DATA SFAC/9.765625D-4/ * .. Executable Statements .. WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -38,7 +38,7 @@ PROGRAM DCBLAT1 + ICASE.EQ.10) THEN CALL CHECK1(SFAC) ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR. - + ICASE.EQ.6) THEN + + ICASE.EQ.6 .OR. ICASE.EQ.11 ) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.EQ.4) THEN CALL CHECK3(SFAC) @@ -59,7 +59,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*15 L(10) + CHARACTER*15 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. @@ -73,6 +73,8 @@ SUBROUTINE HEADER DATA L(8)/'CBLAS_DASUM '/ DATA L(9)/'CBLAS_DSCAL '/ DATA L(10)/'CBLAS_IDAMAX'/ + DATA L(11)/'CBLAS_DAXPBY'/ + * .. Executable Statements .. WRITE (NOUT,99999) ICASE, L(ICASE) RETURN @@ -244,25 +246,27 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - DOUBLE PRECISION SA + DOUBLE PRECISION SA, SB INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY * .. Local Arrays .. DOUBLE PRECISION DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4), + DT8(7,4,4), DX1(7), + DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7), - + SX(7), SY(7) + + SX(7), SY(7), DT20(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. EXTERNAL DDOTTEST DOUBLE PRECISION DDOTTEST * .. External Subroutines .. EXTERNAL DAXPYTEST, DCOPYTEST, DSWAPTEST, STEST, STEST1 + + DAXPBYTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA SA/0.3D0/ + DATA SB/0.5D0/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -335,6 +339,27 @@ SUBROUTINE CHECK2(SFAC) + 0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, + 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, + 1.17D0, 1.17D0, 1.17D0/ + DATA DT20/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.43D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.43D0, -0.42D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.43D0, -0.42D0, 0.0D0, + + 0.59D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.43D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.1D0, -0.9D0, 0.33D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.13D0, -0.9D0, 0.42D0, 0.7D0, -0.45D0, + + 0.2D0, 0.58D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.43D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.1D0, -0.27D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.13D0, + + -0.18D0, 0.00D0, 0.53D0, 0.0D0, 0.0D0, 0.0D0, + + 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.43D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.43D0, -0.9D0, 0.18D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.43D0, -0.9D0, 0.18D0, 0.7D0, + + -0.45D0, 0.2D0, 0.64D0/ + + * .. Executable Statements .. * DO 120 KI = 1, 4 @@ -365,6 +390,14 @@ SUBROUTINE CHECK2(SFAC) STY(J) = DT8(J,KN,KI) 40 CONTINUE CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.11) THEN +* .. DAXPBYTEST .. + CALL DAXPBYTEST(N,SA,SX,INCX,SB,SY,INCY) + DO 50 J = 1, LENY + STY(J) = DT20(J,KN,KI) + 50 CONTINUE + CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.5) THEN * .. DCOPYTEST .. DO 60 I = 1, 7 diff --git a/CBLAS/testing/c_sblas1.c b/CBLAS/testing/c_sblas1.c index e5a88766ff..133944afbc 100644 --- a/CBLAS/testing/c_sblas1.c +++ b/CBLAS/testing/c_sblas1.c @@ -20,6 +20,14 @@ void F77_saxpy(const CBLAS_INT *N, const float *alpha, const float *X, return; } +void F77_saxpby(const CBLAS_INT *N, const float *alpha, const float *X, + const CBLAS_INT *incX, const float *beta, float *Y, const CBLAS_INT *incY) +{ + cblas_saxpby(*N, *alpha, X, *incX, *beta, Y, *incY); + return; +} + + float F77_scasum(const CBLAS_INT *N, void *X, const CBLAS_INT *incX) { return cblas_scasum(*N, X, *incX); diff --git a/CBLAS/testing/c_sblat1.f b/CBLAS/testing/c_sblat1.f index 89902f12d9..1050cfc80e 100644 --- a/CBLAS/testing/c_sblat1.f +++ b/CBLAS/testing/c_sblat1.f @@ -19,7 +19,7 @@ PROGRAM SCBLAT1 DATA SFAC/9.765625E-4/ * .. Executable Statements .. WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -38,7 +38,7 @@ PROGRAM SCBLAT1 + ICASE.EQ.10) THEN CALL CHECK1(SFAC) ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR. - + ICASE.EQ.6) THEN + + ICASE.EQ.6 .OR. ICASE.EQ.11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.EQ.4) THEN CALL CHECK3(SFAC) @@ -59,7 +59,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*15 L(10) + CHARACTER*15 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. @@ -73,6 +73,8 @@ SUBROUTINE HEADER DATA L(8)/'CBLAS_SASUM '/ DATA L(9)/'CBLAS_SSCAL '/ DATA L(10)/'CBLAS_ISAMAX'/ + DATA L(11)/'CBLAS_SAXPBY'/ + * .. Executable Statements .. WRITE (NOUT,99999) ICASE, L(ICASE) RETURN @@ -244,25 +246,27 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - REAL SA + REAL SA, SB INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY * .. Local Arrays .. REAL DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4), + DT8(7,4,4), DX1(7), + DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7), - + SX(7), SY(7) + + SX(7), SY(7), DT20(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. REAL SDOTTEST EXTERNAL SDOTTEST * .. External Subroutines .. EXTERNAL SAXPYTEST, SCOPYTEST, SSWAPTEST, STEST, STEST1 + + SAXPBYTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA SA/0.3E0/ + DATA SB/0.5E0/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -335,6 +339,26 @@ SUBROUTINE CHECK2(SFAC) + 0.0E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, + 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, + 1.17E0, 1.17E0, 1.17E0/ + DATA DT20/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.43E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.43E0, -0.42E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.43E0, -0.42E0, 0.0E0, + + 0.59E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.43E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.1E0, -0.9E0, 0.33E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.13E0, -0.9E0, 0.42E0, 0.7E0, -0.45E0, + + 0.2E0, 0.58E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.43E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.1E0, -0.27E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.13E0, + + -0.18E0, 0.00E0, 0.53E0, 0.0E0, 0.0E0, 0.0E0, + + 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.43E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.43E0, -0.9E0, 0.18E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.43E0, -0.9E0, 0.18E0, 0.7E0, + + -0.45E0, 0.2E0, 0.64E0/ + * .. Executable Statements .. * DO 120 KI = 1, 4 @@ -365,6 +389,13 @@ SUBROUTINE CHECK2(SFAC) STY(J) = DT8(J,KN,KI) 40 CONTINUE CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.11) THEN +* .. SAXPBYTEST .. + CALL SAXPBYTEST(N,SA,SX,INCX,SB,SY,INCY) + DO 50 J = 1, LENY + STY(J) = DT20(J,KN,KI) + 50 CONTINUE + CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) ELSE IF (ICASE.EQ.5) THEN * .. SCOPYTEST .. DO 60 I = 1, 7 diff --git a/CBLAS/testing/c_zblas1.c b/CBLAS/testing/c_zblas1.c index 698397db4b..48d7eaf61f 100644 --- a/CBLAS/testing/c_zblas1.c +++ b/CBLAS/testing/c_zblas1.c @@ -15,6 +15,14 @@ void F77_zaxpy(const CBLAS_INT *N, const void *alpha, void *X, return; } + +void F77_zaxpby(const CBLAS_INT *N, const void *alpha, void *X, + const CBLAS_INT *incX, const void *beta, void *Y, const CBLAS_INT *incY) +{ + cblas_zaxpby(*N, alpha, X, *incX, beta, Y, *incY); + return; +} + void F77_zcopy(const CBLAS_INT *N, void *X, const CBLAS_INT *incX, void *Y, const CBLAS_INT *incY) { diff --git a/CBLAS/testing/c_zblat1.f b/CBLAS/testing/c_zblat1.f index cd0c8541df..03abc52b46 100644 --- a/CBLAS/testing/c_zblat1.f +++ b/CBLAS/testing/c_zblat1.f @@ -19,7 +19,7 @@ PROGRAM ZCBLAT1 DATA SFAC/9.765625D-4/ * .. Executable Statements .. WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -32,7 +32,7 @@ PROGRAM ZCBLAT1 INCX = 9999 INCY = 9999 MODE = 9999 - IF (ICASE.LE.5) THEN + IF (ICASE.LE.5 .OR. ICASE .EQ. 11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.GE.6) THEN CALL CHECK1(SFAC) @@ -53,7 +53,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*15 L(10) + CHARACTER*15 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. @@ -67,6 +67,8 @@ SUBROUTINE HEADER DATA L(8)/'CBLAS_ZSCAL'/ DATA L(9)/'CBLAS_ZDSCAL'/ DATA L(10)/'CBLAS_IZAMAX'/ + DATA L(11)/'CBLAS_ZAXPBY'/ + * .. Executable Statements .. WRITE (NOUT,99999) ICASE, L(ICASE) RETURN @@ -284,23 +286,26 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - COMPLEX*16 CA,ZTEMP + COMPLEX*16 CA,CB,ZTEMP INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY * .. Local Arrays .. COMPLEX*16 CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14), + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4), - + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7) + + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7), + + CT11(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. EXTERNAL ZDOTCTEST, ZDOTUTEST * .. External Subroutines .. EXTERNAL ZAXPYTEST, ZCOPYTEST, ZSWAPTEST, CTEST + + ZAXPBYTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA CA/(0.4D0,-0.7D0)/ + DATA CB/(0.7D0,-0.4D0)/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -470,6 +475,53 @@ SUBROUTINE CHECK2(SFAC) + (1.54D0,1.54D0), (1.54D0,1.54D0), + (1.54D0,1.54D0), (1.54D0,1.54D0), + (1.54D0,1.54D0), (1.54D0,1.54D0)/ + DATA ((CT11(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.1D0,-1.47D0), + + (-1.08D0,0.71D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (-1.08D0,0.71D0), + + (-0.42D0,-0.99D0), (-0.61D0,-0.85D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ + DATA ((CT11(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.49D0,-0.95D0), + + (-0.9D0,0.5D0),(-0.03D0,-1.51D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.36D0,0.00D0), (-0.9D0,0.5D0), + + (-0.39D0,-0.23D0), (0.1D0,-0.5D0), + + (-0.82D0,-0.39D0), (-0.5D0,-0.3D0), + + (0.0D0,-1.62D0)/ + DATA ((CT11(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.49D0,-0.95D0), + + (-0.71D0,-0.1D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.36D0,0.00D0), (-1.07D0,1.18D0), + + (-0.42D0,-0.99D0), (-0.41D0,-1.2D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ + DATA ((CT11(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.1D0,-1.47D0), (-0.9D0,0.5D0), + + (-0.4D0,-0.7D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.1D0,-1.47D0), + + (-0.9D0,0.5D0),(-0.4D0,-0.7D0), (0.1D0,-0.5D0), + + (-0.82D0,-0.39D0), (-0.5D0,-0.3D0), + + (-0.2D0,-1.27D0)/ + + * .. Executable Statements .. DO 60 KI = 1, 4 INCX = INCXS(KI) @@ -501,6 +553,10 @@ SUBROUTINE CHECK2(SFAC) * .. ZAXPYTEST .. CALL ZAXPYTEST(N,CA,CX,INCX,CY,INCY) CALL CTEST(LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.11) THEN +* .. ZAXPBYTEST .. + CALL ZAXPBYTEST(N,CA,CX,INCX,CB,CY,INCY) + CALL CTEST(LENY,CY,CT11(1,KN,KI),CSIZE2(1,KSIZE),SFAC) ELSE IF (ICASE.EQ.4) THEN * .. ZCOPYTEST .. CALL ZCOPYTEST(N,CX,INCX,CY,INCY)