From 02b71fcbc659cd3b31cbf1c46000fafb4739e1a3 Mon Sep 17 00:00:00 2001 From: Angelika Schwarz Date: Mon, 26 Sep 2022 19:12:13 +0200 Subject: [PATCH 1/2] Add interfaces cblas_[c,z]rotg, cblas_[cs,zd]rot Closes #473 --- CBLAS/include/cblas.h | 26 +++++++++++++++++--------- CBLAS/include/cblas_f77.h | 14 ++++++++++++++ CBLAS/src/CMakeLists.txt | 6 ++++-- CBLAS/src/Makefile | 6 ++++-- CBLAS/src/cblas_crotg.c | 13 +++++++++++++ CBLAS/src/cblas_csrot.c | 21 +++++++++++++++++++++ CBLAS/src/cblas_zdrot.c | 21 +++++++++++++++++++++ CBLAS/src/cblas_zrotg.c | 13 +++++++++++++ 8 files changed, 107 insertions(+), 13 deletions(-) create mode 100644 CBLAS/src/cblas_crotg.c create mode 100644 CBLAS/src/cblas_csrot.c create mode 100644 CBLAS/src/cblas_zdrot.c create mode 100644 CBLAS/src/cblas_zrotg.c diff --git a/CBLAS/include/cblas.h b/CBLAS/include/cblas.h index 8dd1c5506a..f7d411571c 100644 --- a/CBLAS/include/cblas.h +++ b/CBLAS/include/cblas.h @@ -143,19 +143,13 @@ void cblas_zaxpy(const CBLAS_INT N, const void *alpha, const void *X, /* * Routines with S and D prefix only */ -void cblas_srotg(float *a, float *b, float *c, float *s); void cblas_srotmg(float *d1, float *d2, float *b1, const float b2, float *P); -void cblas_srot(const CBLAS_INT N, float *X, const CBLAS_INT incX, - float *Y, const CBLAS_INT incY, const float c, const float s); void cblas_srotm(const CBLAS_INT N, float *X, const CBLAS_INT incX, - float *Y, const CBLAS_INT incY, const float *P); - -void cblas_drotg(double *a, double *b, double *c, double *s); + float *Y, const CBLAS_INT incY, const float *P); void cblas_drotmg(double *d1, double *d2, double *b1, const double b2, double *P); -void cblas_drot(const CBLAS_INT N, double *X, const CBLAS_INT incX, - double *Y, const CBLAS_INT incY, const double c, const double s); void cblas_drotm(const CBLAS_INT N, double *X, const CBLAS_INT incX, - double *Y, const CBLAS_INT incY, const double *P); + double *Y, const CBLAS_INT incY, const double *P); + /* @@ -168,6 +162,20 @@ void cblas_zscal(const CBLAS_INT N, const void *alpha, void *X, const CBLAS_INT void cblas_csscal(const CBLAS_INT N, const float alpha, void *X, const CBLAS_INT incX); void cblas_zdscal(const CBLAS_INT N, const double alpha, void *X, const CBLAS_INT incX); +void cblas_srotg(float *a, float *b, float *c, float *s); +void cblas_drotg(double *a, double *b, double *c, double *s); +void cblas_crotg(void *a, void *b, float *c, void *s); +void cblas_zrotg(void *a, void *b, double *c, void *s); + +void cblas_srot(const CBLAS_INT N, float *X, const CBLAS_INT incX, + float *Y, const CBLAS_INT incY, const float c, const float s); +void cblas_drot(const CBLAS_INT N, double *X, const CBLAS_INT incX, + double *Y, const CBLAS_INT incY, const double c, const double s); +void cblas_csrot(const CBLAS_INT N, void *X, const CBLAS_INT incX, + void *Y, const CBLAS_INT incY, const float c, const float s); +void cblas_zdrot(const CBLAS_INT N, void *X, const CBLAS_INT incX, + void *Y, const CBLAS_INT incY, const double c, const double s); + /* * =========================================================================== * Prototypes for level 2 BLAS diff --git a/CBLAS/include/cblas_f77.h b/CBLAS/include/cblas_f77.h index 2df10afedf..e2fe1a8970 100644 --- a/CBLAS/include/cblas_f77.h +++ b/CBLAS/include/cblas_f77.h @@ -93,6 +93,11 @@ #define F77_dznrm2_sub_base F77_GLOBAL(dznrm2sub,DZNRM2SUB) #define F77_dzasum_sub_base F77_GLOBAL(dzasumsub,DZASUMSUB) #define F77_sdsdot_sub_base F77_GLOBAL(sdsdotsub,SDSDOTSUB) +#define F77_crotg_base F77_GLOBAL(crotg, CROTG) +#define F77_csrot_base F77_GLOBAL(csrot, CSROT) +#define F77_zrotg_base F77_GLOBAL(zrotg, ZROTG) +#define F77_zdrot_base F77_GLOBAL(zdrot, ZDROT) + /* * Level 2 BLAS */ @@ -200,6 +205,7 @@ * Level 1 Fortran variadic definitions */ + /* Single Precision */ #define F77_srot(...) F77_srot_base(__VA_ARGS__) @@ -235,6 +241,8 @@ /* Single Complex Precision */ + #define F77_crotg(...) F77_crotg_base(__VA_ARGS__) + #define F77_csrot(...) F77_csrot_base(__VA_ARGS__) #define F77_cswap(...) F77_cswap_base(__VA_ARGS__) #define F77_ccopy(...) F77_ccopy_base(__VA_ARGS__) #define F77_caxpy(...) F77_caxpy_base(__VA_ARGS__) @@ -249,6 +257,8 @@ /* Double Complex Precision */ + #define F77_zrotg(...) F77_zrotg_base(__VA_ARGS__) + #define F77_zdrot(...) F77_zdrot_base(__VA_ARGS__) #define F77_zswap(...) F77_zswap_base(__VA_ARGS__) #define F77_zcopy(...) F77_zcopy_base(__VA_ARGS__) #define F77_zaxpy(...) F77_zaxpy_base(__VA_ARGS__) @@ -579,6 +589,8 @@ void F77_xerbla_base(FCHAR, void * /* Single Complex Precision */ + void F77_crotg_base(void *, void *, float *, void *); + void F77_csrot_base(FINT, void *X, FINT, void *, FINT, const float *, const float *); 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); @@ -593,6 +605,8 @@ void F77_xerbla_base(FCHAR, void * /* Double Complex Precision */ + void F77_zrotg_base(void *, void *, double *, void *); + void F77_zdrot_base(FINT, void *X, FINT, void *, FINT, const double *, const double *); 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); diff --git a/CBLAS/src/CMakeLists.txt b/CBLAS/src/CMakeLists.txt index 2791434046..0b4cf97f10 100644 --- a/CBLAS/src/CMakeLists.txt +++ b/CBLAS/src/CMakeLists.txt @@ -26,12 +26,14 @@ set(DLEV1 cblas_drotg.c cblas_drotmg.c cblas_drot.c cblas_drotm.c dasumsub.f idamaxsub.f) # Files for level 1 single precision complex -set(CLEV1 cblas_cswap.c cblas_cscal.c cblas_csscal.c cblas_ccopy.c +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) # Files for level 1 double precision complex -set(ZLEV1 cblas_zswap.c cblas_zscal.c cblas_zdscal.c cblas_zcopy.c +set(ZLEV1 cblas_zrotg.c cblas_zdrot.c + cblas_zswap.c cblas_zscal.c cblas_zdscal.c cblas_zcopy.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) diff --git a/CBLAS/src/Makefile b/CBLAS/src/Makefile index 7100568e4e..32f3308c8c 100644 --- a/CBLAS/src/Makefile +++ b/CBLAS/src/Makefile @@ -36,12 +36,14 @@ dlev1 = cblas_drotg.o cblas_drotmg.o cblas_drot.o cblas_drotm.o \ dasumsub.o idamaxsub.o # Files for level 1 single precision complex -clev1 = cblas_cswap.o cblas_cscal.o cblas_csscal.o cblas_ccopy.o \ +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 # Files for level 1 double precision complex -zlev1 = cblas_zswap.o cblas_zscal.o cblas_zdscal.o cblas_zcopy.o \ +zlev1 = cblas_zrotg.o cblas_zdrot.o \ + cblas_zswap.o cblas_zscal.o cblas_zdscal.o cblas_zcopy.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 diff --git a/CBLAS/src/cblas_crotg.c b/CBLAS/src/cblas_crotg.c new file mode 100644 index 0000000000..36ca354b0c --- /dev/null +++ b/CBLAS/src/cblas_crotg.c @@ -0,0 +1,13 @@ +/* + * cblas_crotg.c + * + * The program is a C interface to crotg. + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void cblas_crotg(void *a, void *b, float *c, void *s) +{ + F77_crotg(a,b,c,s); +} + diff --git a/CBLAS/src/cblas_csrot.c b/CBLAS/src/cblas_csrot.c new file mode 100644 index 0000000000..39963c034a --- /dev/null +++ b/CBLAS/src/cblas_csrot.c @@ -0,0 +1,21 @@ +/* + * cblas_csrot.c + * + * The program is a C interface to csrot. + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void cblas_csrot(const CBLAS_INT N, void *X, const CBLAS_INT incX, + void *Y, const CBLAS_INT incY, const float c, const float s) +{ +#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_csrot(&F77_N, X, &F77_incX, Y, &F77_incY, &c, &s); + return; +} diff --git a/CBLAS/src/cblas_zdrot.c b/CBLAS/src/cblas_zdrot.c new file mode 100644 index 0000000000..bf0d5c69db --- /dev/null +++ b/CBLAS/src/cblas_zdrot.c @@ -0,0 +1,21 @@ +/* + * cblas_zdrot.c + * + * The program is a C interface to zdrot. + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void cblas_zdrot(const CBLAS_INT N, void *X, const CBLAS_INT incX, + void *Y, const CBLAS_INT incY, const double c, const double s) +{ +#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_zdrot(&F77_N, X, &F77_incX, Y, &F77_incY, &c, &s); + return; +} diff --git a/CBLAS/src/cblas_zrotg.c b/CBLAS/src/cblas_zrotg.c new file mode 100644 index 0000000000..94ca0bede0 --- /dev/null +++ b/CBLAS/src/cblas_zrotg.c @@ -0,0 +1,13 @@ +/* + * cblas_zrotg.c + * + * The program is a C interface to zrotg. + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void cblas_zrotg(void *a, void *b, double *c, void *s) +{ + F77_zrotg(a,b,c,s); +} + From a8028e9ddcb866e5d5018b6cdde5f09fe62f2830 Mon Sep 17 00:00:00 2001 From: Angelika Schwarz Date: Sun, 2 Oct 2022 16:54:32 +0200 Subject: [PATCH 2/2] Fix undefined reference to cblas_[sd]cabs1 cblas.h defines double cblas_dcabs1(const void *z); float cblas_scabs1(const void *c); but does not provide an implementation. This commit adds the missing implementation in the common CBLAS style and eliminates the linker error when calling the above function. --- CBLAS/include/cblas_f77.h | 6 ++++++ CBLAS/src/CMakeLists.txt | 6 ++++-- CBLAS/src/Makefile | 6 ++++-- CBLAS/src/cblas_dcabs1.c | 15 +++++++++++++++ CBLAS/src/cblas_scabs1.c | 15 +++++++++++++++ CBLAS/src/dcabs1sub.f | 13 +++++++++++++ CBLAS/src/scabs1sub.f | 13 +++++++++++++ 7 files changed, 70 insertions(+), 4 deletions(-) create mode 100644 CBLAS/src/cblas_dcabs1.c create mode 100644 CBLAS/src/cblas_scabs1.c create mode 100644 CBLAS/src/dcabs1sub.f create mode 100644 CBLAS/src/scabs1sub.f diff --git a/CBLAS/include/cblas_f77.h b/CBLAS/include/cblas_f77.h index e2fe1a8970..8d8e929873 100644 --- a/CBLAS/include/cblas_f77.h +++ b/CBLAS/include/cblas_f77.h @@ -97,6 +97,8 @@ #define F77_csrot_base F77_GLOBAL(csrot, CSROT) #define F77_zrotg_base F77_GLOBAL(zrotg, ZROTG) #define F77_zdrot_base F77_GLOBAL(zdrot, ZDROT) +#define F77_scabs1_sub_base F77_GLOBAL(scabs1sub, SCABS1SUB) +#define F77_dcabs1_sub_base F77_GLOBAL(dcabs1sub, DCABS1SUB) /* * Level 2 BLAS @@ -221,6 +223,7 @@ #define F77_snrm2_sub(...) F77_snrm2_sub_base(__VA_ARGS__) #define F77_sasum_sub(...) F77_sasum_sub_base(__VA_ARGS__) #define F77_isamax_sub(...) F77_isamax_sub_base(__VA_ARGS__) + #define F77_scabs1_sub(...) F77_scabs1_sub_base(__VA_ARGS__) /* Double Precision */ @@ -238,6 +241,7 @@ #define F77_dnrm2_sub(...) F77_dnrm2_sub_base(__VA_ARGS__) #define F77_dasum_sub(...) F77_dasum_sub_base(__VA_ARGS__) #define F77_idamax_sub(...) F77_idamax_sub_base(__VA_ARGS__) + #define F77_dcabs1_sub(...) F77_dcabs1_sub_base(__VA_ARGS__) /* Single Complex Precision */ @@ -602,6 +606,7 @@ void F77_xerbla_base(FCHAR, void * void F77_csscal_base( FINT, const float *, void *, FINT); void F77_scnrm2_sub_base( FINT, const void *, FINT, float *); void F77_scasum_sub_base( FINT, const void *, FINT, float *); + void F77_scabs1_sub_base( const void *, float *); /* Double Complex Precision */ @@ -618,6 +623,7 @@ void F77_xerbla_base(FCHAR, void * void F77_dznrm2_sub_base( FINT, const void *, FINT, double *); void F77_dzasum_sub_base( FINT, const void *, FINT, double *); void F77_izamax_sub_base( FINT, const void *, FINT, FINT2); + void F77_dcabs1_sub_base( const void *, double *); /* * Level 2 Fortran Prototypes diff --git a/CBLAS/src/CMakeLists.txt b/CBLAS/src/CMakeLists.txt index 0b4cf97f10..a8152297a9 100644 --- a/CBLAS/src/CMakeLists.txt +++ b/CBLAS/src/CMakeLists.txt @@ -29,14 +29,16 @@ set(DLEV1 cblas_drotg.c cblas_drotmg.c cblas_drot.c cblas_drotm.c 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_icamax.c cdotcsub.f cdotusub.f icamaxsub.f + cblas_scabs1.c scabs1sub.f ) # Files for level 1 double precision complex set(ZLEV1 cblas_zrotg.c cblas_zdrot.c cblas_zswap.c cblas_zscal.c cblas_zdscal.c cblas_zcopy.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) + dzasumsub.f dznrm2sub.f izamaxsub.f + cblas_dcabs1.c dcabs1sub.f) # 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 32f3308c8c..a455cd66be 100644 --- a/CBLAS/src/Makefile +++ b/CBLAS/src/Makefile @@ -39,14 +39,16 @@ dlev1 = cblas_drotg.o cblas_drotmg.o cblas_drot.o cblas_drotm.o \ 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_icamax.o cdotcsub.o cdotusub.o icamaxsub.o \ + cblas_scabs1.o scabs1sub.o # Files for level 1 double precision complex zlev1 = cblas_zrotg.o cblas_zdrot.o \ cblas_zswap.o cblas_zscal.o cblas_zdscal.o cblas_zcopy.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 + dzasumsub.o dznrm2sub.o izamaxsub.o \ + cblas_dcabs1.o dcabs1sub.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_dcabs1.c b/CBLAS/src/cblas_dcabs1.c new file mode 100644 index 0000000000..27902e8e40 --- /dev/null +++ b/CBLAS/src/cblas_dcabs1.c @@ -0,0 +1,15 @@ +/* + * cblas_scabs1.c + * + * The program is a C interface to scabs1. + * + */ +#include "cblas.h" +#include "cblas_f77.h" +double cblas_dcabs1(const void *c) +{ + double cabs1 = 0.0; + F77_dcabs1_sub(c, &cabs1); + return cabs1; +} + diff --git a/CBLAS/src/cblas_scabs1.c b/CBLAS/src/cblas_scabs1.c new file mode 100644 index 0000000000..8aaf0b9af9 --- /dev/null +++ b/CBLAS/src/cblas_scabs1.c @@ -0,0 +1,15 @@ +/* + * cblas_scabs1.c + * + * The program is a C interface to scabs1. + * + */ +#include "cblas.h" +#include "cblas_f77.h" +float cblas_scabs1(const void *c) +{ + float cabs1 = 0.0; + F77_scabs1_sub(c, &cabs1); + return cabs1; +} + diff --git a/CBLAS/src/dcabs1sub.f b/CBLAS/src/dcabs1sub.f new file mode 100644 index 0000000000..0c085f7670 --- /dev/null +++ b/CBLAS/src/dcabs1sub.f @@ -0,0 +1,13 @@ +c dcabs1.f +c +c The program is a fortran wrapper for dcabs1. +c + subroutine dcabs1sub(z, cabs1) +c + external dcabs1 + double complex z + double precision dcabs1, cabs1 +c + cabs1=dcabs1(z) + return + end diff --git a/CBLAS/src/scabs1sub.f b/CBLAS/src/scabs1sub.f new file mode 100644 index 0000000000..17dbfde278 --- /dev/null +++ b/CBLAS/src/scabs1sub.f @@ -0,0 +1,13 @@ +c scabs1.f +c +c The program is a fortran wrapper for scabs1. +c + subroutine scabs1sub(z, cabs1) +c + external scabs1 + complex z + real scabs1, cabs1 +c + cabs1=scabs1(z) + return + end