From fd455d2617476810afe49400f24b403284e3b552 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Tue, 16 May 2023 11:59:36 +0300 Subject: [PATCH 01/40] Replace npy_c* structs with native types --- numpy/core/include/numpy/ndarraytypes.h | 20 ++--- numpy/core/include/numpy/npy_common.h | 54 ++++++------ numpy/core/include/numpy/npy_math.h | 61 ++++---------- numpy/core/src/common/cblasfuncs.c | 8 +- numpy/core/src/multiarray/arraytypes.c.src | 61 +++++++------- numpy/core/src/multiarray/buffer.c | 10 +-- numpy/core/src/multiarray/compiled_base.c | 52 ++++++------ numpy/core/src/multiarray/convert_datatype.c | 12 +-- numpy/core/src/multiarray/scalarapi.c | 4 +- numpy/core/src/multiarray/scalartypes.c.src | 82 +++++++++++-------- .../src/multiarray/textreading/conversions.c | 8 +- numpy/core/src/npysort/npysort_common.h | 42 +++++----- numpy/core/src/umath/clip.cpp | 29 ++++++- numpy/core/src/umath/funcs.inc.src | 37 +++++---- numpy/core/src/umath/loops.c.src | 20 ++--- numpy/core/src/umath/matmul.c.src | 12 +-- numpy/core/src/umath/scalarmath.c.src | 66 +++++++++------ numpy/linalg/umath_linalg.cpp | 22 +++-- 18 files changed, 322 insertions(+), 278 deletions(-) diff --git a/numpy/core/include/numpy/ndarraytypes.h b/numpy/core/include/numpy/ndarraytypes.h index 1891820143c1..d267acfbcf76 100644 --- a/numpy/core/include/numpy/ndarraytypes.h +++ b/numpy/core/include/numpy/ndarraytypes.h @@ -962,16 +962,16 @@ typedef int (PyArray_FinalizeFunc)(PyArrayObject *, PyObject *); #define PyArray_MAX(a,b) (((a)>(b))?(a):(b)) #define PyArray_MIN(a,b) (((a)<(b))?(a):(b)) -#define PyArray_CLT(p,q) ((((p).real==(q).real) ? ((p).imag < (q).imag) : \ - ((p).real < (q).real))) -#define PyArray_CGT(p,q) ((((p).real==(q).real) ? ((p).imag > (q).imag) : \ - ((p).real > (q).real))) -#define PyArray_CLE(p,q) ((((p).real==(q).real) ? ((p).imag <= (q).imag) : \ - ((p).real <= (q).real))) -#define PyArray_CGE(p,q) ((((p).real==(q).real) ? ((p).imag >= (q).imag) : \ - ((p).real >= (q).real))) -#define PyArray_CEQ(p,q) (((p).real==(q).real) && ((p).imag == (q).imag)) -#define PyArray_CNE(p,q) (((p).real!=(q).real) || ((p).imag != (q).imag)) +#define PyArray_CLT(p,q, type) (((NPY_##type##_GET_REAL(&p)==NPY_##type##_GET_REAL(&q)) ? (NPY_##type##_GET_IMAG(&p) < NPY_##type##_GET_IMAG(&q)) : \ + (NPY_##type##_GET_REAL(&p) < NPY_##type##_GET_REAL(&q)))) +#define PyArray_CGT(p,q, type) (((NPY_##type##_GET_REAL(&p)==NPY_##type##_GET_REAL(&q)) ? (NPY_##type##_GET_IMAG(&p) > NPY_##type##_GET_IMAG(&q)) : \ + (NPY_##type##_GET_REAL(&p) > NPY_##type##_GET_REAL(&q)))) +#define PyArray_CLE(p,q, type) (((NPY_##type##_GET_REAL(&p)==NPY_##type##_GET_REAL(&q)) ? (NPY_##type##_GET_IMAG(&p) <= NPY_##type##_GET_IMAG(&q)) : \ + (NPY_##type##_GET_REAL(&p) <= NPY_##type##_GET_REAL(&q)))) +#define PyArray_CGE(p,q, type) (((NPY_##type##_GET_REAL(&p)==NPY_##type##_GET_REAL(&q)) ? (NPY_##type##_GET_IMAG(&p) >= NPY_##type##_GET_IMAG(&q)) : \ + (NPY_##type##_GET_REAL(&p) >= NPY_##type##_GET_REAL(&q)))) +#define PyArray_CEQ(p,q, type) ((NPY_##type##_GET_REAL(&p)==NPY_##type##_GET_REAL(&q)) && (NPY_##type##_GET_IMAG(&p) == NPY_##type##_GET_IMAG(&q))) +#define PyArray_CNE(p,q, type) ((NPY_##type##_GET_REAL(&p)!=NPY_##type##_GET_REAL(&q)) || (NPY_##type##_GET_IMAG(&p) != NPY_##type##_GET_IMAG(&q))) /* * C API: consists of Macros and functions. The MACROS are defined diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index fb976aa6ae09..23c5c3d643e9 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -333,9 +333,11 @@ typedef unsigned char npy_bool; */ #if NPY_SIZEOF_LONGDOUBLE == NPY_SIZEOF_DOUBLE #define NPY_LONGDOUBLE_FMT "g" + #define longdouble_t double typedef double npy_longdouble; #else #define NPY_LONGDOUBLE_FMT "Lg" + #define longdouble_t long double typedef long double npy_longdouble; #endif @@ -361,49 +363,51 @@ typedef double npy_double; typedef Py_hash_t npy_hash_t; #define NPY_SIZEOF_HASH_T NPY_SIZEOF_INTP -/* - * Disabling C99 complex usage: a lot of C code in numpy/scipy rely on being - * able to do .real/.imag. Will have to convert code first. - */ -#if 0 -#if defined(NPY_USE_C99_COMPLEX) && defined(NPY_HAVE_COMPLEX_DOUBLE) -typedef complex npy_cdouble; -#else -typedef struct { double real, imag; } npy_cdouble; -#endif - -#if defined(NPY_USE_C99_COMPLEX) && defined(NPY_HAVE_COMPLEX_FLOAT) -typedef complex float npy_cfloat; +#ifdef __cplusplus +extern "C++" { +#include +} #else -typedef struct { float real, imag; } npy_cfloat; +#include #endif -#if defined(NPY_USE_C99_COMPLEX) && defined(NPY_HAVE_COMPLEX_LONG_DOUBLE) -typedef complex long double npy_clongdouble; -#else -typedef struct {npy_longdouble real, imag;} npy_clongdouble; -#endif -#endif #if NPY_SIZEOF_COMPLEX_DOUBLE != 2 * NPY_SIZEOF_DOUBLE #error npy_cdouble definition is not compatible with C99 complex definition ! \ Please contact NumPy maintainers and give detailed information about your \ compiler and platform #endif -typedef struct { double real, imag; } npy_cdouble; - #if NPY_SIZEOF_COMPLEX_FLOAT != 2 * NPY_SIZEOF_FLOAT #error npy_cfloat definition is not compatible with C99 complex definition ! \ Please contact NumPy maintainers and give detailed information about your \ compiler and platform #endif -typedef struct { float real, imag; } npy_cfloat; - #if NPY_SIZEOF_COMPLEX_LONGDOUBLE != 2 * NPY_SIZEOF_LONGDOUBLE #error npy_clongdouble definition is not compatible with C99 complex definition ! \ Please contact NumPy maintainers and give detailed information about your \ compiler and platform #endif -typedef struct { npy_longdouble real, imag; } npy_clongdouble; + + +#if !defined(__cplusplus) && defined(_MSC_VER) && !defined(__INTEL_COMPILER) +typedef _Dcomplex npy_cdouble; +typedef _Fcomplex npy_cfloat; +typedef _Lcomplex npy_clongdouble; +#elif defined(__cplusplus) /* && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ +typedef std::complex npy_cdouble; +typedef std::complex npy_cfloat; +typedef std::complex npy_clongdouble; +#else /* !defined(__cplusplus) && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ +typedef complex double npy_cdouble; +typedef complex float npy_cfloat; +typedef complex longdouble_t npy_clongdouble; +#endif + +#define NPY_CDOUBLE_GET_REAL(comp) ( *((double *) (comp)) ) +#define NPY_CDOUBLE_GET_IMAG(comp) ( *(((double *) (comp)) + 1) ) +#define NPY_CFLOAT_GET_REAL(comp) ( *((float *) (comp)) ) +#define NPY_CFLOAT_GET_IMAG(comp) ( *(((float *) (comp)) + 1) ) +#define NPY_CLONGDOUBLE_GET_REAL(comp) ( *((npy_longdouble *) (comp)) ) +#define NPY_CLONGDOUBLE_GET_IMAG(comp) ( *(((npy_longdouble *) (comp)) + 1) ) /* * numarray-style bit-width typedefs diff --git a/numpy/core/include/numpy/npy_math.h b/numpy/core/include/numpy/npy_math.h index 2fcd41eb0ba9..bd1f88b0fb28 100644 --- a/numpy/core/include/numpy/npy_math.h +++ b/numpy/core/include/numpy/npy_math.h @@ -357,84 +357,59 @@ NPY_INPLACE npy_longdouble npy_heavisidel(npy_longdouble x, npy_longdouble h0); * Complex declarations */ -/* - * C99 specifies that complex numbers have the same representation as - * an array of two elements, where the first element is the real part - * and the second element is the imaginary part. - */ -#define __NPY_CPACK_IMP(x, y, type, ctype) \ - union { \ - ctype z; \ - type a[2]; \ - } z1; \ - \ - z1.a[0] = (x); \ - z1.a[1] = (y); \ - \ - return z1.z; - static inline npy_cdouble npy_cpack(double x, double y) { - __NPY_CPACK_IMP(x, y, double, npy_cdouble); + npy_cdouble z; + NPY_CDOUBLE_GET_REAL(&z) = x; + NPY_CDOUBLE_GET_IMAG(&z) = y; + return z; } static inline npy_cfloat npy_cpackf(float x, float y) { - __NPY_CPACK_IMP(x, y, float, npy_cfloat); + npy_cfloat z; + NPY_CFLOAT_GET_REAL(&z) = x; + NPY_CFLOAT_GET_IMAG(&z) = y; + return z; } static inline npy_clongdouble npy_cpackl(npy_longdouble x, npy_longdouble y) { - __NPY_CPACK_IMP(x, y, npy_longdouble, npy_clongdouble); + npy_clongdouble z; + NPY_CLONGDOUBLE_GET_REAL(&z) = x; + NPY_CLONGDOUBLE_GET_IMAG(&z) = y; + return z; } -#undef __NPY_CPACK_IMP - -/* - * Same remark as above, but in the other direction: extract first/second - * member of complex number, assuming a C99-compatible representation - * - * Those are defineds as static inline, and such as a reasonable compiler would - * most likely compile this to one or two instructions (on CISC at least) - */ -#define __NPY_CEXTRACT_IMP(z, index, type, ctype) \ - union { \ - ctype z; \ - type a[2]; \ - } __z_repr; \ - __z_repr.z = z; \ - \ - return __z_repr.a[index]; static inline double npy_creal(npy_cdouble z) { - __NPY_CEXTRACT_IMP(z, 0, double, npy_cdouble); + return NPY_CDOUBLE_GET_REAL(&z); } static inline double npy_cimag(npy_cdouble z) { - __NPY_CEXTRACT_IMP(z, 1, double, npy_cdouble); + return NPY_CDOUBLE_GET_IMAG(&z); } static inline float npy_crealf(npy_cfloat z) { - __NPY_CEXTRACT_IMP(z, 0, float, npy_cfloat); + return NPY_CFLOAT_GET_REAL(&z); } static inline float npy_cimagf(npy_cfloat z) { - __NPY_CEXTRACT_IMP(z, 1, float, npy_cfloat); + return NPY_CFLOAT_GET_IMAG(&z); } static inline npy_longdouble npy_creall(npy_clongdouble z) { - __NPY_CEXTRACT_IMP(z, 0, npy_longdouble, npy_clongdouble); + return NPY_CLONGDOUBLE_GET_REAL(&z); } static inline npy_longdouble npy_cimagl(npy_clongdouble z) { - __NPY_CEXTRACT_IMP(z, 1, npy_longdouble, npy_clongdouble); + return NPY_CLONGDOUBLE_GET_IMAG(&z); } -#undef __NPY_CEXTRACT_IMP /* * Double precision complex functions diff --git a/numpy/core/src/common/cblasfuncs.c b/numpy/core/src/common/cblasfuncs.c index 714636782663..54053ed3cc2a 100644 --- a/numpy/core/src/common/cblasfuncs.c +++ b/numpy/core/src/common/cblasfuncs.c @@ -422,8 +422,8 @@ cblas_matrixproduct(int typenum, PyArrayObject *ap1, PyArrayObject *ap2, ptr1 = (npy_cdouble *)PyArray_DATA(ap2); ptr2 = (npy_cdouble *)PyArray_DATA(ap1); res = (npy_cdouble *)PyArray_DATA(out_buf); - res->real = ptr1->real * ptr2->real - ptr1->imag * ptr2->imag; - res->imag = ptr1->real * ptr2->imag + ptr1->imag * ptr2->real; + NPY_CDOUBLE_GET_REAL(res) = NPY_CDOUBLE_GET_REAL(ptr1) * NPY_CDOUBLE_GET_REAL(ptr2) - NPY_CDOUBLE_GET_IMAG(ptr1) * NPY_CDOUBLE_GET_IMAG(ptr2); + NPY_CDOUBLE_GET_IMAG(res) = NPY_CDOUBLE_GET_REAL(ptr1) * NPY_CDOUBLE_GET_IMAG(ptr2) + NPY_CDOUBLE_GET_IMAG(ptr1) * NPY_CDOUBLE_GET_REAL(ptr2); } else if (ap1shape != _matrix) { CBLAS_FUNC(cblas_zaxpy)(l, @@ -495,8 +495,8 @@ cblas_matrixproduct(int typenum, PyArrayObject *ap1, PyArrayObject *ap2, ptr1 = (npy_cfloat *)PyArray_DATA(ap2); ptr2 = (npy_cfloat *)PyArray_DATA(ap1); res = (npy_cfloat *)PyArray_DATA(out_buf); - res->real = ptr1->real * ptr2->real - ptr1->imag * ptr2->imag; - res->imag = ptr1->real * ptr2->imag + ptr1->imag * ptr2->real; + NPY_CFLOAT_GET_REAL(res) = NPY_CFLOAT_GET_REAL(ptr1) * NPY_CFLOAT_GET_REAL(ptr2) - NPY_CFLOAT_GET_IMAG(ptr1) * NPY_CFLOAT_GET_IMAG(ptr2); + NPY_CFLOAT_GET_IMAG(res) = NPY_CFLOAT_GET_REAL(ptr1) * NPY_CFLOAT_GET_IMAG(ptr2) + NPY_CFLOAT_GET_IMAG(ptr1) * NPY_CFLOAT_GET_REAL(ptr2); } else if (ap1shape != _matrix) { CBLAS_FUNC(cblas_caxpy)(l, diff --git a/numpy/core/src/multiarray/arraytypes.c.src b/numpy/core/src/multiarray/arraytypes.c.src index 10cdc1394e7a..1c157aadcdf6 100644 --- a/numpy/core/src/multiarray/arraytypes.c.src +++ b/numpy/core/src/multiarray/arraytypes.c.src @@ -2,6 +2,7 @@ #define PY_SSIZE_T_CLEAN #include #include +#include #include #include @@ -500,13 +501,13 @@ NPY_NO_EXPORT int return -1; } } - temp.real = (@ftype@) oop.real; - temp.imag = (@ftype@) oop.imag; + NPY_@NAME@_GET_REAL(&temp) = (@ftype@) oop.real; + NPY_@NAME@_GET_IMAG(&temp) = (@ftype@) oop.imag; #if NPY_SIZEOF_@NAME@ < NPY_SIZEOF_CDOUBLE /* really just float... */ /* Overflow could have occurred converting double to float */ - if (NPY_UNLIKELY((npy_isinf(temp.real) && !npy_isinf(oop.real)) || - (npy_isinf(temp.imag) && !npy_isinf(oop.imag)))) { + if (NPY_UNLIKELY((npy_isinf(NPY_@NAME@_GET_REAL(&temp)) && !npy_isinf(oop.real)) || + (npy_isinf(NPY_@NAME@_GET_IMAG(&temp)) && !npy_isinf(oop.imag)))) { if (PyUFunc_GiveFloatingpointErrors("cast", NPY_FPE_OVERFLOW) < 0) { return -1; } @@ -1531,8 +1532,8 @@ static void npy_bool *op = output; while (n--) { - *op = (npy_bool)((ip->real != NPY_FALSE) || - (ip->imag != NPY_FALSE)); + *op = (npy_bool)((NPY_@FROMTYPE@_GET_REAL(ip) != NPY_FALSE) || + (NPY_@FROMTYPE@_GET_IMAG(ip) != NPY_FALSE)); op++; ip++; } @@ -1947,7 +1948,7 @@ static int char next = getc(fp); if ((next == '+') || (next == '-')) { // Imaginary component specified - output.real = result; + NPY_@fname@_GET_REAL(&output) = result; // Revert peek and read imaginary component ungetc(next, fp); ret_imag = NumPyOS_ascii_ftolf(fp, &result); @@ -1955,23 +1956,23 @@ static int next = getc(fp); if ((ret_imag == 1) && (next == 'j')) { // If read is successful and the immediate following char is j - output.imag = result; + NPY_@fname@_GET_IMAG(&output) = result; } else { - output.imag = 0; + NPY_@fname@_GET_IMAG(&output) = 0; // Push an invalid char to trigger the not everything is read error ungetc('a', fp); } } else if (next == 'j') { // Real component not specified - output.real = 0; - output.imag = result; + NPY_@fname@_GET_REAL(&output) = 0; + NPY_@fname@_GET_IMAG(&output) = result; } else { // Imaginary component not specified - output.real = result; - output.imag = 0.; + NPY_@fname@_GET_REAL(&output) = result; + NPY_@fname@_GET_IMAG(&output) = 0.; // Next character is not + / - / j. Revert peek. ungetc(next, fp); } @@ -2088,14 +2089,14 @@ static int if (endptr && ((*endptr[0] == '+') || (*endptr[0] == '-'))) { // Imaginary component specified - output.real = result; + NPY_@fname@_GET_REAL(&output) = result; // Reading imaginary component char **prev = endptr; str = *endptr; result = NumPyOS_ascii_strtod(str, endptr); if (endptr && *endptr[0] == 'j') { // Read is successful if the immediate following char is j - output.imag = result; + NPY_@fname@_GET_IMAG(&output) = result; // Skip j ++*endptr; } @@ -2105,20 +2106,20 @@ static int * read error */ endptr = prev; - output.imag = 0; + NPY_@fname@_GET_IMAG(&output) = 0; } } else if (endptr && *endptr[0] == 'j') { // Real component not specified - output.real = 0; - output.imag = result; + NPY_@fname@_GET_REAL(&output) = 0; + NPY_@fname@_GET_IMAG(&output) = result; // Skip j ++*endptr; } else { // Imaginary component not specified - output.real = result; - output.imag = 0.; + NPY_@fname@_GET_REAL(&output) = result; + NPY_@fname@_GET_IMAG(&output) = 0.; } *(@type@ *)ip = output; return 0; @@ -2783,13 +2784,13 @@ static npy_bool { if (ap == NULL || PyArray_ISBEHAVED_RO(ap)) { @type@ *ptmp = (@type@ *)ip; - return (npy_bool) ((ptmp->real != 0) || (ptmp->imag != 0)); + return (npy_bool) ((NPY_@fname@_GET_REAL(ptmp) != 0) || (NPY_@fname@_GET_IMAG(ptmp) != 0)); } else { @type@ tmp; PyArray_DESCR(ap)->f->copyswap(&tmp, ip, PyArray_ISBYTESWAPPED(ap), ap); - return (npy_bool) ((tmp.real != 0) || (tmp.imag != 0)); + return (npy_bool) ((NPY_@fname@_GET_REAL(&tmp) != 0) || (NPY_@fname@_GET_IMAG(&tmp) != 0)); } } /**end repeat**/ @@ -3983,16 +3984,16 @@ static int @type@ start; @type@ delta; - start.real = buffer->real; - start.imag = buffer->imag; - delta.real = buffer[1].real; - delta.imag = buffer[1].imag; - delta.real -= start.real; - delta.imag -= start.imag; + NPY_@NAME@_GET_REAL(&start) = NPY_@NAME@_GET_REAL(buffer); + NPY_@NAME@_GET_IMAG(&start) = NPY_@NAME@_GET_IMAG(buffer); + NPY_@NAME@_GET_REAL(&delta) = NPY_@NAME@_GET_REAL(&buffer[1]); + NPY_@NAME@_GET_IMAG(&delta) = NPY_@NAME@_GET_IMAG(&buffer[1]); + NPY_@NAME@_GET_REAL(&delta) -= NPY_@NAME@_GET_REAL(&start); + NPY_@NAME@_GET_IMAG(&delta) -= NPY_@NAME@_GET_IMAG(&start); buffer += 2; for (i = 2; i < length; i++, buffer++) { - buffer->real = start.real + i*delta.real; - buffer->imag = start.imag + i*delta.imag; + NPY_@NAME@_GET_REAL(buffer) = NPY_@NAME@_GET_REAL(&start) + i*NPY_@NAME@_GET_REAL(&delta); + NPY_@NAME@_GET_IMAG(buffer) = NPY_@NAME@_GET_IMAG(&start) + i*NPY_@NAME@_GET_IMAG(&delta); } return 0; } diff --git a/numpy/core/src/multiarray/buffer.c b/numpy/core/src/multiarray/buffer.c index c9d881e164fb..4a5158bad1a7 100644 --- a/numpy/core/src/multiarray/buffer.c +++ b/numpy/core/src/multiarray/buffer.c @@ -903,7 +903,7 @@ static int _descriptor_from_pep3118_format_fast(char const *s, PyObject **result); static int -_pep3118_letter_to_type(char letter, int native, int complex); +_pep3118_letter_to_type(char letter, int native, int _complex); NPY_NO_EXPORT PyArray_Descr* _descriptor_from_pep3118_format(char const *s) @@ -1066,7 +1066,7 @@ _descriptor_from_pep3118_format_fast(char const *s, PyObject **result) } static int -_pep3118_letter_to_type(char letter, int native, int complex) +_pep3118_letter_to_type(char letter, int native, int _complex) { switch (letter) { @@ -1082,9 +1082,9 @@ _pep3118_letter_to_type(char letter, int native, int complex) case 'q': return native ? NPY_LONGLONG : NPY_INT64; case 'Q': return native ? NPY_ULONGLONG : NPY_UINT64; case 'e': return NPY_HALF; - case 'f': return complex ? NPY_CFLOAT : NPY_FLOAT; - case 'd': return complex ? NPY_CDOUBLE : NPY_DOUBLE; - case 'g': return native ? (complex ? NPY_CLONGDOUBLE : NPY_LONGDOUBLE) : -1; + case 'f': return _complex ? NPY_CFLOAT : NPY_FLOAT; + case 'd': return _complex ? NPY_CDOUBLE : NPY_DOUBLE; + case 'g': return native ? (_complex ? NPY_CLONGDOUBLE : NPY_LONGDOUBLE) : -1; default: /* Other unhandled cases */ return -1; diff --git a/numpy/core/src/multiarray/compiled_base.c b/numpy/core/src/multiarray/compiled_base.c index 405d19363ba5..b67c81b0cc64 100644 --- a/numpy/core/src/multiarray/compiled_base.c +++ b/numpy/core/src/multiarray/compiled_base.c @@ -734,12 +734,12 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t lval = dy[0]; } else { - lval.real = PyComplex_RealAsDouble(left); - if (error_converting(lval.real)) { + NPY_CDOUBLE_GET_REAL(&lval) = PyComplex_RealAsDouble(left); + if (error_converting(NPY_CDOUBLE_GET_REAL(&lval))) { goto fail; } - lval.imag = PyComplex_ImagAsDouble(left); - if (error_converting(lval.imag)) { + NPY_CDOUBLE_GET_IMAG(&lval) = PyComplex_ImagAsDouble(left); + if (error_converting(NPY_CDOUBLE_GET_IMAG(&lval))) { goto fail; } } @@ -748,12 +748,12 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t rval = dy[lenxp - 1]; } else { - rval.real = PyComplex_RealAsDouble(right); - if (error_converting(rval.real)) { + NPY_CDOUBLE_GET_REAL(&rval) = PyComplex_RealAsDouble(right); + if (error_converting(NPY_CDOUBLE_GET_REAL(&rval))) { goto fail; } - rval.imag = PyComplex_ImagAsDouble(right); - if (error_converting(rval.imag)) { + NPY_CDOUBLE_GET_IMAG(&rval) = PyComplex_ImagAsDouble(right); + if (error_converting(NPY_CDOUBLE_GET_IMAG(&rval))) { goto fail; } } @@ -788,8 +788,8 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t if (slopes != NULL) { for (i = 0; i < lenxp - 1; ++i) { const double inv_dx = 1.0 / (dx[i+1] - dx[i]); - slopes[i].real = (dy[i+1].real - dy[i].real) * inv_dx; - slopes[i].imag = (dy[i+1].imag - dy[i].imag) * inv_dx; + NPY_CDOUBLE_GET_REAL(&slopes[i]) = (NPY_CDOUBLE_GET_REAL(&dy[i+1]) - NPY_CDOUBLE_GET_REAL(&dy[i])) * inv_dx; + NPY_CDOUBLE_GET_IMAG(&slopes[i]) = (NPY_CDOUBLE_GET_IMAG(&dy[i+1]) - NPY_CDOUBLE_GET_IMAG(&dy[i])) * inv_dx; } } @@ -797,8 +797,8 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t const npy_double x_val = dz[i]; if (npy_isnan(x_val)) { - dres[i].real = x_val; - dres[i].imag = 0.0; + NPY_CDOUBLE_GET_REAL(&dres[i]) = x_val; + NPY_CDOUBLE_GET_IMAG(&dres[i]) = 0.0; continue; } @@ -823,25 +823,25 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t } else { const npy_double inv_dx = 1.0 / (dx[j+1] - dx[j]); - slope.real = (dy[j+1].real - dy[j].real) * inv_dx; - slope.imag = (dy[j+1].imag - dy[j].imag) * inv_dx; + NPY_CDOUBLE_GET_REAL(&slope) = (NPY_CDOUBLE_GET_REAL(&dy[j+1]) - NPY_CDOUBLE_GET_REAL(&dy[j])) * inv_dx; + NPY_CDOUBLE_GET_IMAG(&slope) = (NPY_CDOUBLE_GET_IMAG(&dy[j+1]) - NPY_CDOUBLE_GET_IMAG(&dy[j])) * inv_dx; } /* If we get nan in one direction, try the other */ - dres[i].real = slope.real*(x_val - dx[j]) + dy[j].real; - if (NPY_UNLIKELY(npy_isnan(dres[i].real))) { - dres[i].real = slope.real*(x_val - dx[j+1]) + dy[j+1].real; - if (NPY_UNLIKELY(npy_isnan(dres[i].real)) && - dy[j].real == dy[j+1].real) { - dres[i].real = dy[j].real; + NPY_CDOUBLE_GET_REAL(&dres[i]) = NPY_CDOUBLE_GET_REAL(&slope)*(x_val - dx[j]) + NPY_CDOUBLE_GET_REAL(&dy[j]); + if (NPY_UNLIKELY(npy_isnan(NPY_CDOUBLE_GET_REAL(&dres[i])))) { + NPY_CDOUBLE_GET_REAL(&dres[i]) = NPY_CDOUBLE_GET_REAL(&slope)*(x_val - dx[j+1]) + NPY_CDOUBLE_GET_REAL(&dy[j+1]); + if (NPY_UNLIKELY(npy_isnan(NPY_CDOUBLE_GET_REAL(&dres[i]))) && + NPY_CDOUBLE_GET_REAL(&dy[j]) == NPY_CDOUBLE_GET_REAL(&dy[j+1])) { + NPY_CDOUBLE_GET_REAL(&dres[i]) = NPY_CDOUBLE_GET_REAL(&dy[j]); } } - dres[i].imag = slope.imag*(x_val - dx[j]) + dy[j].imag; - if (NPY_UNLIKELY(npy_isnan(dres[i].imag))) { - dres[i].imag = slope.imag*(x_val - dx[j+1]) + dy[j+1].imag; - if (NPY_UNLIKELY(npy_isnan(dres[i].imag)) && - dy[j].imag == dy[j+1].imag) { - dres[i].imag = dy[j].imag; + NPY_CDOUBLE_GET_IMAG(&dres[i]) = NPY_CDOUBLE_GET_IMAG(&slope)*(x_val - dx[j]) + NPY_CDOUBLE_GET_IMAG(&dy[j]); + if (NPY_UNLIKELY(npy_isnan(NPY_CDOUBLE_GET_IMAG(&dres[i])))) { + NPY_CDOUBLE_GET_IMAG(&dres[i]) = NPY_CDOUBLE_GET_IMAG(&slope)*(x_val - dx[j+1]) + NPY_CDOUBLE_GET_IMAG(&dy[j+1]); + if (NPY_UNLIKELY(npy_isnan(NPY_CDOUBLE_GET_IMAG(&dres[i]))) && + NPY_CDOUBLE_GET_IMAG(&dy[j]) == NPY_CDOUBLE_GET_IMAG(&dy[j+1])) { + NPY_CDOUBLE_GET_IMAG(&dres[i]) = NPY_CDOUBLE_GET_IMAG(&dy[j]); } } } diff --git a/numpy/core/src/multiarray/convert_datatype.c b/numpy/core/src/multiarray/convert_datatype.c index 4311139f2b43..3362ebc2b2d3 100644 --- a/numpy/core/src/multiarray/convert_datatype.c +++ b/numpy/core/src/multiarray/convert_datatype.c @@ -1539,8 +1539,8 @@ static int min_scalar_type_num(char *valueptr, int type_num, NPY_DOUBLE, is_small_unsigned); } */ - if (value.real > -3.4e38 && value.real < 3.4e38 && - value.imag > -3.4e38 && value.imag < 3.4e38) { + if (NPY_CDOUBLE_GET_REAL(&value) > -3.4e38 && NPY_CDOUBLE_GET_REAL(&value) < 3.4e38 && + NPY_CDOUBLE_GET_IMAG(&value) > -3.4e38 && NPY_CDOUBLE_GET_IMAG(&value) < 3.4e38) { return NPY_CFLOAT; } break; @@ -1553,12 +1553,12 @@ static int min_scalar_type_num(char *valueptr, int type_num, NPY_LONGDOUBLE, is_small_unsigned); } */ - if (value.real > -3.4e38 && value.real < 3.4e38 && - value.imag > -3.4e38 && value.imag < 3.4e38) { + if (NPY_CLONGDOUBLE_GET_REAL(&value) > -3.4e38 && NPY_CLONGDOUBLE_GET_REAL(&value) < 3.4e38 && + NPY_CLONGDOUBLE_GET_IMAG(&value) > -3.4e38 && NPY_CLONGDOUBLE_GET_IMAG(&value) < 3.4e38) { return NPY_CFLOAT; } - else if (value.real > -1.7e308 && value.real < 1.7e308 && - value.imag > -1.7e308 && value.imag < 1.7e308) { + else if (NPY_CLONGDOUBLE_GET_REAL(&value) > -1.7e308 && NPY_CLONGDOUBLE_GET_REAL(&value) < 1.7e308 && + NPY_CLONGDOUBLE_GET_IMAG(&value) > -1.7e308 && NPY_CLONGDOUBLE_GET_IMAG(&value) < 1.7e308) { return NPY_CDOUBLE; } break; diff --git a/numpy/core/src/multiarray/scalarapi.c b/numpy/core/src/multiarray/scalarapi.c index 40f1da2c4a96..5195237b90e6 100644 --- a/numpy/core/src/multiarray/scalarapi.c +++ b/numpy/core/src/multiarray/scalarapi.c @@ -373,8 +373,8 @@ PyArray_ScalarFromObject(PyObject *object) else if (PyComplex_Check(object)) { ret = PyArrayScalar_New(CDouble); if (ret != NULL) { - PyArrayScalar_VAL(ret, CDouble).real = PyComplex_RealAsDouble(object); - PyArrayScalar_VAL(ret, CDouble).imag = PyComplex_ImagAsDouble(object); + NPY_CDOUBLE_GET_REAL(&PyArrayScalar_VAL(ret, CDouble)) = PyComplex_RealAsDouble(object); + NPY_CDOUBLE_GET_IMAG(&PyArrayScalar_VAL(ret, CDouble)) = PyComplex_ImagAsDouble(object); } return ret; } diff --git a/numpy/core/src/multiarray/scalartypes.c.src b/numpy/core/src/multiarray/scalartypes.c.src index ff30737b5fb5..c2bfcaad5459 100644 --- a/numpy/core/src/multiarray/scalartypes.c.src +++ b/numpy/core/src/multiarray/scalartypes.c.src @@ -783,6 +783,7 @@ extern int npy_legacy_print_mode; /**begin repeat1 * #name = cfloat, cdouble, clongdouble# * #NAME = FLOAT, DOUBLE, LONGDOUBLE# + * #TYPE = CFLOAT, CDOUBLE, CLONGDOUBLE# * #type = npy_cfloat, npy_cdouble, npy_clongdouble# * #suff = f, d, l# */ @@ -799,14 +800,14 @@ legacy_@name@_format@kind@(@type@ val) /* * Ideally, we should handle this nan/inf stuff in NumpyOS_ascii_format* */ - if (val.real == 0.0 && npy_signbit(val.real) == 0) { + if (NPY_@TYPE@_GET_REAL(&val) == 0.0 && npy_signbit(NPY_@TYPE@_GET_REAL(&val)) == 0) { PyOS_snprintf(format, sizeof(format), _FMT1, @NAME@PREC_@KIND@); - res = NumPyOS_ascii_format@suff@(buf, sizeof(buf) - 1, format, val.imag, 0); + res = NumPyOS_ascii_format@suff@(buf, sizeof(buf) - 1, format, NPY_@TYPE@_GET_IMAG(&val), 0); if (res == NULL) { PyErr_SetString(PyExc_RuntimeError, "Error while formatting"); return NULL; } - if (!npy_isfinite(val.imag)) { + if (!npy_isfinite(NPY_@TYPE@_GET_IMAG(&val))) { strncat(buf, "*", sizeof(buf) - strlen(buf) - 1); } strncat(buf, "j", sizeof(buf) - strlen(buf) - 1); @@ -814,20 +815,20 @@ legacy_@name@_format@kind@(@type@ val) else { char re[64], im[64]; - if (npy_isfinite(val.real)) { + if (npy_isfinite(NPY_@TYPE@_GET_REAL(&val))) { PyOS_snprintf(format, sizeof(format), _FMT1, @NAME@PREC_@KIND@); res = NumPyOS_ascii_format@suff@(re, sizeof(re), format, - val.real, 0); + NPY_@TYPE@_GET_REAL(&val), 0); if (res == NULL) { PyErr_SetString(PyExc_RuntimeError, "Error while formatting"); return NULL; } } else { - if (npy_isnan(val.real)) { + if (npy_isnan(NPY_@TYPE@_GET_REAL(&val))) { strcpy(re, "nan"); } - else if (val.real > 0){ + else if (NPY_@TYPE@_GET_REAL(&val) > 0){ strcpy(re, "inf"); } else { @@ -836,26 +837,26 @@ legacy_@name@_format@kind@(@type@ val) } - if (npy_isfinite(val.imag)) { + if (npy_isfinite(NPY_@TYPE@_GET_IMAG(&val))) { PyOS_snprintf(format, sizeof(format), _FMT2, @NAME@PREC_@KIND@); res = NumPyOS_ascii_format@suff@(im, sizeof(im), format, - val.imag, 0); + NPY_@TYPE@_GET_IMAG(&val), 0); if (res == NULL) { PyErr_SetString(PyExc_RuntimeError, "Error while formatting"); return NULL; } } else { - if (npy_isnan(val.imag)) { + if (npy_isnan(NPY_@TYPE@_GET_IMAG(&val))) { strcpy(im, "+nan"); } - else if (val.imag > 0){ + else if (NPY_@TYPE@_GET_IMAG(&val) > 0){ strcpy(im, "+inf"); } else { strcpy(im, "-inf"); } - if (!npy_isfinite(val.imag)) { + if (!npy_isfinite(NPY_@TYPE@_GET_IMAG(&val))) { strncat(im, "*", sizeof(im) - strlen(im) - 1); } } @@ -971,8 +972,8 @@ c@name@type_@kind@(PyObject *self) return legacy_c@name@_format@kind@(val); } - if (val.real == 0.0 && npy_signbit(val.real) == 0) { - istr = @name@type_@kind@_either(val.imag, trim, trim, 0); + if (NPY_C@NAME@_GET_REAL(&val) == 0.0 && npy_signbit(NPY_C@NAME@_GET_REAL(&val)) == 0) { + istr = @name@type_@kind@_either(NPY_C@NAME@_GET_IMAG(&val), trim, trim, 0); if (istr == NULL) { return NULL; } @@ -981,13 +982,13 @@ c@name@type_@kind@(PyObject *self) return ret; } - if (npy_isfinite(val.real)) { - rstr = @name@type_@kind@_either(val.real, trim, trim, 0); + if (npy_isfinite(NPY_C@NAME@_GET_REAL(&val))) { + rstr = @name@type_@kind@_either(NPY_C@NAME@_GET_REAL(&val), trim, trim, 0); } - else if (npy_isnan(val.real)) { + else if (npy_isnan(NPY_C@NAME@_GET_REAL(&val))) { rstr = PyUnicode_FromString("nan"); } - else if (val.real > 0){ + else if (NPY_C@NAME@_GET_REAL(&val) > 0){ rstr = PyUnicode_FromString("inf"); } else { @@ -997,13 +998,13 @@ c@name@type_@kind@(PyObject *self) return NULL; } - if (npy_isfinite(val.imag)) { - istr = @name@type_@kind@_either(val.imag, trim, trim, 1); + if (npy_isfinite(NPY_C@NAME@_GET_IMAG(&val))) { + istr = @name@type_@kind@_either(NPY_C@NAME@_GET_IMAG(&val), trim, trim, 1); } - else if (npy_isnan(val.imag)) { + else if (npy_isnan(NPY_C@NAME@_GET_IMAG(&val))) { istr = PyUnicode_FromString("+nan"); } - else if (val.imag > 0){ + else if (NPY_C@NAME@_GET_IMAG(&val) > 0){ istr = PyUnicode_FromString("+inf"); } else { @@ -1047,26 +1048,33 @@ halftype_@kind@(PyObject *self) /**end repeat**/ -/**begin repeat - * #char = ,c# - * #CHAR = ,C# - * #POST = ,.real# - */ static PyObject * -@char@longdoubletype_float(PyObject *self) +longdoubletype_float(PyObject *self) { - npy_longdouble val = PyArrayScalar_VAL(self, @CHAR@LongDouble)@POST@; + npy_longdouble val = PyArrayScalar_VAL(self, LongDouble); return PyFloat_FromDouble((double) val); } static PyObject * -@char@longdoubletype_long(PyObject *self) +longdoubletype_long(PyObject *self) { - npy_longdouble val = PyArrayScalar_VAL(self, @CHAR@LongDouble)@POST@; + npy_longdouble val = PyArrayScalar_VAL(self, LongDouble); return npy_longdouble_to_PyLong(val); } -/**end repeat**/ +static PyObject * +clongdoubletype_float(PyObject *self) +{ + npy_longdouble val = NPY_CLONGDOUBLE_GET_REAL(&PyArrayScalar_VAL(self, CLongDouble)); + return PyFloat_FromDouble((double) val); +} + +static PyObject * +clongdoubletype_long(PyObject *self) +{ + npy_longdouble val = NPY_CLONGDOUBLE_GET_REAL(&PyArrayScalar_VAL(self, CLongDouble)); + return npy_longdouble_to_PyLong(val); +} static PyNumberMethods gentype_as_number = { .nb_add = (binaryfunc)gentype_add, @@ -1932,13 +1940,14 @@ numbertype_class_getitem(PyObject *cls, PyObject *args) /**begin repeat * #name = cfloat, clongdouble# * #Name = CFloat, CLongDouble# + * #NAME = CFLOAT, CLONGDOUBLE# */ static PyObject * @name@_complex(PyObject *self, PyObject *NPY_UNUSED(args), PyObject *NPY_UNUSED(kwds)) { - return PyComplex_FromDoubles(PyArrayScalar_VAL(self, @Name@).real, - PyArrayScalar_VAL(self, @Name@).imag); + return PyComplex_FromDoubles(NPY_@NAME@_GET_REAL(&PyArrayScalar_VAL(self, @Name@)), + NPY_@NAME@_GET_IMAG(&PyArrayScalar_VAL(self, @Name@))); } /**end repeat**/ @@ -3409,6 +3418,7 @@ static npy_hash_t /**begin repeat * #lname = float, longdouble# * #name = Float, LongDouble# + * #NAME = FLOAT, LONGDOUBLE# */ static npy_hash_t @lname@_arrtype_hash(PyObject *obj) @@ -3422,13 +3432,13 @@ c@lname@_arrtype_hash(PyObject *obj) { npy_hash_t hashreal, hashimag, combined; hashreal = Npy_HashDouble( - obj, (double)PyArrayScalar_VAL(obj, C@name@).real); + obj, (double)NPY_C@NAME@_GET_REAL(&PyArrayScalar_VAL(obj, C@name@))); if (hashreal == -1) { return -1; } hashimag = Npy_HashDouble( - obj, (double)PyArrayScalar_VAL(obj, C@name@).imag); + obj, (double)NPY_C@NAME@_GET_IMAG(&PyArrayScalar_VAL(obj, C@name@))); if (hashimag == -1) { return -1; } diff --git a/numpy/core/src/multiarray/textreading/conversions.c b/numpy/core/src/multiarray/textreading/conversions.c index 67a4803b9ea1..f1c57b18a720 100644 --- a/numpy/core/src/multiarray/textreading/conversions.c +++ b/numpy/core/src/multiarray/textreading/conversions.c @@ -242,7 +242,9 @@ npy_to_cfloat(PyArray_Descr *descr, if (!success) { return -1; } - npy_complex64 val = {(float)real, (float)imag}; + npy_complex64 val; + NPY_CFLOAT_GET_REAL(&val) = (float) real; + NPY_CFLOAT_GET_IMAG(&val) = (float) imag; memcpy(dataptr, &val, sizeof(npy_complex64)); if (!PyArray_ISNBO(descr->byteorder)) { npy_bswap4_unaligned(dataptr); @@ -266,7 +268,9 @@ npy_to_cdouble(PyArray_Descr *descr, if (!success) { return -1; } - npy_complex128 val = {real, imag}; + npy_complex128 val; + NPY_CDOUBLE_GET_REAL(&val) = real; + NPY_CDOUBLE_GET_IMAG(&val) = imag; memcpy(dataptr, &val, sizeof(npy_complex128)); if (!PyArray_ISNBO(descr->byteorder)) { npy_bswap8_unaligned(dataptr); diff --git a/numpy/core/src/npysort/npysort_common.h b/numpy/core/src/npysort/npysort_common.h index 851eb89daaef..a79fefe3029e 100644 --- a/numpy/core/src/npysort/npysort_common.h +++ b/numpy/core/src/npysort/npysort_common.h @@ -197,17 +197,17 @@ CFLOAT_LT(npy_cfloat a, npy_cfloat b) { int ret; - if (a.real < b.real) { - ret = a.imag == a.imag || b.imag != b.imag; + if (NPY_CFLOAT_GET_REAL(&a) < NPY_CFLOAT_GET_REAL(&b)) { + ret = NPY_CFLOAT_GET_IMAG(&a) == NPY_CFLOAT_GET_IMAG(&a) || NPY_CFLOAT_GET_IMAG(&b) != NPY_CFLOAT_GET_IMAG(&b); } - else if (a.real > b.real) { - ret = b.imag != b.imag && a.imag == a.imag; + else if (NPY_CFLOAT_GET_REAL(&a) > NPY_CFLOAT_GET_REAL(&b)) { + ret = NPY_CFLOAT_GET_IMAG(&b) != NPY_CFLOAT_GET_IMAG(&b) && NPY_CFLOAT_GET_IMAG(&a) == NPY_CFLOAT_GET_IMAG(&a); } - else if (a.real == b.real || (a.real != a.real && b.real != b.real)) { - ret = a.imag < b.imag || (b.imag != b.imag && a.imag == a.imag); + else if (NPY_CFLOAT_GET_REAL(&a) == NPY_CFLOAT_GET_REAL(&b) || (NPY_CFLOAT_GET_REAL(&a) != NPY_CFLOAT_GET_REAL(&a) && NPY_CFLOAT_GET_REAL(&b) != NPY_CFLOAT_GET_REAL(&b))) { + ret = NPY_CFLOAT_GET_IMAG(&a) < NPY_CFLOAT_GET_IMAG(&b) || (NPY_CFLOAT_GET_IMAG(&b) != NPY_CFLOAT_GET_IMAG(&b) && NPY_CFLOAT_GET_IMAG(&a) == NPY_CFLOAT_GET_IMAG(&a)); } else { - ret = b.real != b.real; + ret = NPY_CFLOAT_GET_REAL(&b) != NPY_CFLOAT_GET_REAL(&b); } return ret; @@ -219,17 +219,17 @@ CDOUBLE_LT(npy_cdouble a, npy_cdouble b) { int ret; - if (a.real < b.real) { - ret = a.imag == a.imag || b.imag != b.imag; + if (NPY_CDOUBLE_GET_REAL(&a) < NPY_CDOUBLE_GET_REAL(&b)) { + ret = NPY_CDOUBLE_GET_IMAG(&a) == NPY_CDOUBLE_GET_IMAG(&a) || NPY_CDOUBLE_GET_IMAG(&b) != NPY_CDOUBLE_GET_IMAG(&b); } - else if (a.real > b.real) { - ret = b.imag != b.imag && a.imag == a.imag; + else if (NPY_CDOUBLE_GET_REAL(&a) > NPY_CDOUBLE_GET_REAL(&b)) { + ret = NPY_CDOUBLE_GET_IMAG(&b) != NPY_CDOUBLE_GET_IMAG(&b) && NPY_CDOUBLE_GET_IMAG(&a) == NPY_CDOUBLE_GET_IMAG(&a); } - else if (a.real == b.real || (a.real != a.real && b.real != b.real)) { - ret = a.imag < b.imag || (b.imag != b.imag && a.imag == a.imag); + else if (NPY_CDOUBLE_GET_REAL(&a) == NPY_CDOUBLE_GET_REAL(&b) || (NPY_CDOUBLE_GET_REAL(&a) != NPY_CDOUBLE_GET_REAL(&a) && NPY_CDOUBLE_GET_REAL(&b) != NPY_CDOUBLE_GET_REAL(&b))) { + ret = NPY_CDOUBLE_GET_IMAG(&a) < NPY_CDOUBLE_GET_IMAG(&b) || (NPY_CDOUBLE_GET_IMAG(&b) != NPY_CDOUBLE_GET_IMAG(&b) && NPY_CDOUBLE_GET_IMAG(&a) == NPY_CDOUBLE_GET_IMAG(&a)); } else { - ret = b.real != b.real; + ret = NPY_CDOUBLE_GET_REAL(&b) != NPY_CDOUBLE_GET_REAL(&b); } return ret; @@ -241,17 +241,17 @@ CLONGDOUBLE_LT(npy_clongdouble a, npy_clongdouble b) { int ret; - if (a.real < b.real) { - ret = a.imag == a.imag || b.imag != b.imag; + if (NPY_CLONGDOUBLE_GET_REAL(&a) < NPY_CLONGDOUBLE_GET_REAL(&b)) { + ret = NPY_CLONGDOUBLE_GET_IMAG(&a) == NPY_CLONGDOUBLE_GET_IMAG(&a) || NPY_CLONGDOUBLE_GET_IMAG(&b) != NPY_CLONGDOUBLE_GET_IMAG(&b); } - else if (a.real > b.real) { - ret = b.imag != b.imag && a.imag == a.imag; + else if (NPY_CLONGDOUBLE_GET_REAL(&a) > NPY_CLONGDOUBLE_GET_REAL(&b)) { + ret = NPY_CLONGDOUBLE_GET_IMAG(&b) != NPY_CLONGDOUBLE_GET_IMAG(&b) && NPY_CLONGDOUBLE_GET_IMAG(&a) == NPY_CLONGDOUBLE_GET_IMAG(&a); } - else if (a.real == b.real || (a.real != a.real && b.real != b.real)) { - ret = a.imag < b.imag || (b.imag != b.imag && a.imag == a.imag); + else if (NPY_CLONGDOUBLE_GET_REAL(&a) == NPY_CLONGDOUBLE_GET_REAL(&b) || (NPY_CLONGDOUBLE_GET_REAL(&a) != NPY_CLONGDOUBLE_GET_REAL(&a) && NPY_CLONGDOUBLE_GET_REAL(&b) != NPY_CLONGDOUBLE_GET_REAL(&b))) { + ret = NPY_CLONGDOUBLE_GET_IMAG(&a) < NPY_CLONGDOUBLE_GET_IMAG(&b) || (NPY_CLONGDOUBLE_GET_IMAG(&b) != NPY_CLONGDOUBLE_GET_IMAG(&b) && NPY_CLONGDOUBLE_GET_IMAG(&a) == NPY_CLONGDOUBLE_GET_IMAG(&a)); } else { - ret = b.real != b.real; + ret = NPY_CLONGDOUBLE_GET_REAL(&b) != NPY_CLONGDOUBLE_GET_REAL(&b); } return ret; diff --git a/numpy/core/src/umath/clip.cpp b/numpy/core/src/umath/clip.cpp index 19d05c848d9c..5548c9f0ddd5 100644 --- a/numpy/core/src/umath/clip.cpp +++ b/numpy/core/src/umath/clip.cpp @@ -59,17 +59,42 @@ template T _NPY_MIN(T a, T b, npy::complex_tag const &) { - return npy_isnan((a).real) || npy_isnan((a).imag) || PyArray_CLT(a, b) + if (std::is_same::value) { + return npy_isnan(a.real()) || npy_isnan(a.imag()) || PyArray_CLT(a, b, CDOUBLE) ? (a) : (b); + } + else if (std::is_same::value) { + return npy_isnan(a.real()) || npy_isnan(a.imag()) || PyArray_CLT(a, b, CFLOAT) + ? (a) + : (b); + } + else { + return npy_isnan(a.real()) || npy_isnan(a.imag()) || PyArray_CLT(a, b, CLONGDOUBLE) + ? (a) + : (b); + } } + template T _NPY_MAX(T a, T b, npy::complex_tag const &) { - return npy_isnan((a).real) || npy_isnan((a).imag) || PyArray_CGT(a, b) + if (std::is_same::value) { + return npy_isnan(a.real()) || npy_isnan(a.imag()) || PyArray_CGT(a, b, CDOUBLE) ? (a) : (b); + } + else if (std::is_same::value) { + return npy_isnan(a.real()) || npy_isnan(a.imag()) || PyArray_CGT(a, b, CFLOAT) + ? (a) + : (b); + } + else { + return npy_isnan(a.real()) || npy_isnan(a.imag()) || PyArray_CGT(a, b, CLONGDOUBLE) + ? (a) + : (b); + } } template diff --git a/numpy/core/src/umath/funcs.inc.src b/numpy/core/src/umath/funcs.inc.src index 9b04dc77912e..6fd37421fc57 100644 --- a/numpy/core/src/umath/funcs.inc.src +++ b/numpy/core/src/umath/funcs.inc.src @@ -283,6 +283,7 @@ npy_ObjectClip(PyObject *arr, PyObject *min, PyObject *max) { /**begin repeat * + * #NAME = CFLOAT, CDOUBLE, CLONGDOUBLE# * #ctype = npy_cfloat, npy_cdouble, npy_clongdouble# * #ftype = npy_float, npy_double, npy_longdouble# * #c = f, ,l# @@ -291,16 +292,16 @@ npy_ObjectClip(PyObject *arr, PyObject *min, PyObject *max) { static void nc_neg@c@(@ctype@ *a, @ctype@ *r) { - r->real = -a->real; - r->imag = -a->imag; + NPY_@NAME@_GET_REAL(r) = -NPY_@NAME@_GET_REAL(a); + NPY_@NAME@_GET_IMAG(r) = -NPY_@NAME@_GET_IMAG(a); return; } static void nc_pos@c@(@ctype@ *a, @ctype@ *r) { - r->real = +a->real; - r->imag = +a->imag; + NPY_@NAME@_GET_REAL(r) = +NPY_@NAME@_GET_REAL(a); + NPY_@NAME@_GET_IMAG(r) = +NPY_@NAME@_GET_IMAG(a); return; } @@ -314,8 +315,8 @@ nc_sqrt@c@(@ctype@ *x, @ctype@ *r) static void nc_rint@c@(@ctype@ *x, @ctype@ *r) { - r->real = npy_rint@c@(x->real); - r->imag = npy_rint@c@(x->imag); + NPY_@NAME@_GET_REAL(r) = npy_rint@c@(NPY_@NAME@_GET_REAL(x)); + NPY_@NAME@_GET_IMAG(r) = npy_rint@c@(NPY_@NAME@_GET_IMAG(x)); } static void @@ -328,9 +329,9 @@ nc_log@c@(@ctype@ *x, @ctype@ *r) static void nc_log1p@c@(@ctype@ *x, @ctype@ *r) { - @ftype@ l = npy_hypot@c@(x->real + 1,x->imag); - r->imag = npy_atan2@c@(x->imag, x->real + 1); - r->real = npy_log@c@(l); + @ftype@ l = npy_hypot@c@(NPY_@NAME@_GET_REAL(x) + 1,NPY_@NAME@_GET_IMAG(x)); + NPY_@NAME@_GET_IMAG(r) = npy_atan2@c@(NPY_@NAME@_GET_IMAG(x), NPY_@NAME@_GET_REAL(x) + 1); + NPY_@NAME@_GET_REAL(r) = npy_log@c@(l); return; } @@ -345,8 +346,8 @@ static void nc_exp2@c@(@ctype@ *x, @ctype@ *r) { @ctype@ a; - a.real = x->real*NPY_LOGE2@c@; - a.imag = x->imag*NPY_LOGE2@c@; + NPY_@NAME@_GET_REAL(&a) = NPY_@NAME@_GET_REAL(x)*NPY_LOGE2@c@; + NPY_@NAME@_GET_IMAG(&a) = NPY_@NAME@_GET_IMAG(x)*NPY_LOGE2@c@; nc_exp@c@(&a, r); return; } @@ -354,9 +355,9 @@ nc_exp2@c@(@ctype@ *x, @ctype@ *r) static void nc_expm1@c@(@ctype@ *x, @ctype@ *r) { - @ftype@ a = npy_sin@c@(x->imag / 2); - r->real = npy_expm1@c@(x->real) * npy_cos@c@(x->imag) - 2 * a * a; - r->imag = npy_exp@c@(x->real) * npy_sin@c@(x->imag); + @ftype@ a = npy_sin@c@(NPY_@NAME@_GET_IMAG(x) / 2); + NPY_@NAME@_GET_REAL(r) = npy_expm1@c@(NPY_@NAME@_GET_REAL(x)) * npy_cos@c@(NPY_@NAME@_GET_IMAG(x)) - 2 * a * a; + NPY_@NAME@_GET_IMAG(r) = npy_exp@c@(NPY_@NAME@_GET_REAL(x)) * npy_sin@c@(NPY_@NAME@_GET_IMAG(x)); return; } @@ -428,8 +429,8 @@ static void nc_log10@c@(@ctype@ *x, @ctype@ *r) { nc_log@c@(x, r); - r->real *= NPY_LOG10E@c@; - r->imag *= NPY_LOG10E@c@; + NPY_@NAME@_GET_REAL(r) *= NPY_LOG10E@c@; + NPY_@NAME@_GET_IMAG(r) *= NPY_LOG10E@c@; return; } @@ -437,8 +438,8 @@ static void nc_log2@c@(@ctype@ *x, @ctype@ *r) { nc_log@c@(x, r); - r->real *= NPY_LOG2E@c@; - r->imag *= NPY_LOG2E@c@; + NPY_@NAME@_GET_REAL(r) *= NPY_LOG2E@c@; + NPY_@NAME@_GET_IMAG(r) *= NPY_LOG2E@c@; return; } diff --git a/numpy/core/src/umath/loops.c.src b/numpy/core/src/umath/loops.c.src index 97a74b4257aa..c6a907df4531 100644 --- a/numpy/core/src/umath/loops.c.src +++ b/numpy/core/src/umath/loops.c.src @@ -158,11 +158,11 @@ PyUFunc_F_F_As_D_D(char **args, npy_intp const *dimensions, npy_intp const *step func_type *f = (func_type *)func; UNARY_LOOP { npy_cdouble tmp, out; - tmp.real = (double)((float *)ip1)[0]; - tmp.imag = (double)((float *)ip1)[1]; + NPY_CDOUBLE_GET_REAL(&tmp) = (double)((float *)ip1)[0]; + NPY_CDOUBLE_GET_IMAG(&tmp) = (double)((float *)ip1)[1]; f(&tmp, &out); - ((float *)op1)[0] = (float)out.real; - ((float *)op1)[1] = (float)out.imag; + ((float *)op1)[0] = (float)NPY_CDOUBLE_GET_REAL(&out); + ((float *)op1)[1] = (float)NPY_CDOUBLE_GET_IMAG(&out); } } @@ -174,13 +174,13 @@ PyUFunc_FF_F_As_DD_D(char **args, npy_intp const *dimensions, npy_intp const *st func_type *f = (func_type *)func; BINARY_LOOP { npy_cdouble tmp1, tmp2, out; - tmp1.real = (double)((float *)ip1)[0]; - tmp1.imag = (double)((float *)ip1)[1]; - tmp2.real = (double)((float *)ip2)[0]; - tmp2.imag = (double)((float *)ip2)[1]; + NPY_CDOUBLE_GET_REAL(&tmp1) = (double)((float *)ip1)[0]; + NPY_CDOUBLE_GET_IMAG(&tmp1) = (double)((float *)ip1)[1]; + NPY_CDOUBLE_GET_REAL(&tmp2) = (double)((float *)ip2)[0]; + NPY_CDOUBLE_GET_IMAG(&tmp2) = (double)((float *)ip2)[1]; f(&tmp1, &tmp2, &out); - ((float *)op1)[0] = (float)out.real; - ((float *)op1)[1] = (float)out.imag; + ((float *)op1)[0] = (float)NPY_CDOUBLE_GET_REAL(&out); + ((float *)op1)[1] = (float)NPY_CDOUBLE_GET_IMAG(&out); } } diff --git a/numpy/core/src/umath/matmul.c.src b/numpy/core/src/umath/matmul.c.src index 127bb5e27460..35a64658a241 100644 --- a/numpy/core/src/umath/matmul.c.src +++ b/numpy/core/src/umath/matmul.c.src @@ -232,8 +232,8 @@ NPY_NO_EXPORT void for (m = 0; m < dm; m++) { for (p = 0; p < dp; p++) { #if @IS_COMPLEX@ == 1 - (*(@typ@ *)op).real = 0; - (*(@typ@ *)op).imag = 0; + NPY_@TYPE@_GET_REAL(op) = 0; + NPY_@TYPE@_GET_IMAG(op) = 0; #elif @IS_HALF@ float sum = 0; #else @@ -245,10 +245,10 @@ NPY_NO_EXPORT void #if @IS_HALF@ sum += npy_half_to_float(val1) * npy_half_to_float(val2); #elif @IS_COMPLEX@ == 1 - (*(@typ@ *)op).real += (val1.real * val2.real) - - (val1.imag * val2.imag); - (*(@typ@ *)op).imag += (val1.real * val2.imag) + - (val1.imag * val2.real); + NPY_@TYPE@_GET_REAL(op) += (NPY_@TYPE@_GET_REAL(&val1) * NPY_@TYPE@_GET_REAL(&val2)) - + (NPY_@TYPE@_GET_IMAG(&val1) * NPY_@TYPE@_GET_IMAG(&val2)); + NPY_@TYPE@_GET_IMAG(op) += (NPY_@TYPE@_GET_REAL(&val1) * NPY_@TYPE@_GET_IMAG(&val2)) + + (NPY_@TYPE@_GET_IMAG(&val1) * NPY_@TYPE@_GET_REAL(&val2)); #else *(@typ@ *)op += val1 * val2; #endif diff --git a/numpy/core/src/umath/scalarmath.c.src b/numpy/core/src/umath/scalarmath.c.src index a159fdc1201c..4f7da24c1d17 100644 --- a/numpy/core/src/umath/scalarmath.c.src +++ b/numpy/core/src/umath/scalarmath.c.src @@ -422,16 +422,16 @@ half_ctype_divmod(npy_half a, npy_half b, npy_half *out1, npy_half *out2) static inline int @name@_ctype_add(@type@ a, @type@ b, @type@ *out) { - out->real = a.real + b.real; - out->imag = a.imag + b.imag; + NPY_@TYPE@_GET_REAL(out) = NPY_@TYPE@_GET_REAL(&a) + NPY_@TYPE@_GET_REAL(&b); + NPY_@TYPE@_GET_IMAG(out) = NPY_@TYPE@_GET_IMAG(&a) + NPY_@TYPE@_GET_IMAG(&b); return 0; } static inline int @name@_ctype_subtract(@type@ a, @type@ b, @type@ *out) { - out->real = a.real - b.real; - out->imag = a.imag - b.imag; + NPY_@TYPE@_GET_REAL(out) = NPY_@TYPE@_GET_REAL(&a) - NPY_@TYPE@_GET_REAL(&b); + NPY_@TYPE@_GET_IMAG(out) = NPY_@TYPE@_GET_IMAG(&a) - NPY_@TYPE@_GET_IMAG(&b); return 0; } @@ -443,8 +443,8 @@ static inline int static inline int @name@_ctype_multiply( @type@ a, @type@ b, @type@ *out) { - out->real = a.real * b.real - a.imag * b.imag; - out->imag = a.real * b.imag + a.imag * b.real; + NPY_@TYPE@_GET_REAL(out) = NPY_@TYPE@_GET_REAL(&a) * NPY_@TYPE@_GET_REAL(&b) - NPY_@TYPE@_GET_IMAG(&a) * NPY_@TYPE@_GET_IMAG(&b); + NPY_@TYPE@_GET_IMAG(out) = NPY_@TYPE@_GET_REAL(&a) * NPY_@TYPE@_GET_IMAG(&b) + NPY_@TYPE@_GET_IMAG(&a) * NPY_@TYPE@_GET_REAL(&b); return 0; } @@ -550,14 +550,15 @@ half_ctype_negative(npy_half a, npy_half *out) /**begin repeat + * #NAME = CFLOAT, CDOUBLE, CLONGDOUBLE# * #name = cfloat, cdouble, clongdouble# * #type = npy_cfloat, npy_cdouble, npy_clongdouble# */ static inline int @name@_ctype_negative(@type@ a, @type@ *out) { - out->real = -a.real; - out->imag = -a.imag; + NPY_@NAME@_GET_REAL(out) = -NPY_@NAME@_GET_REAL(&a); + NPY_@NAME@_GET_IMAG(out) = -NPY_@NAME@_GET_IMAG(&a); return 0; } /**end repeat**/ @@ -579,6 +580,7 @@ static inline int /**end repeat**/ /**begin repeat + * #NAME = CFLOAT, CDOUBLE, CLONGDOUBLE# * #name = cfloat, cdouble, clongdouble# * #type = npy_cfloat, npy_cdouble, npy_clongdouble# * #c = f,,l# @@ -586,8 +588,8 @@ static inline int static inline int @name@_ctype_positive(@type@ a, @type@ *out) { - out->real = a.real; - out->imag = a.imag; + NPY_@NAME@_GET_REAL(out) = NPY_@NAME@_GET_REAL(&a); + NPY_@NAME@_GET_IMAG(out) = NPY_@NAME@_GET_IMAG(&a); return 0; } @@ -852,8 +854,8 @@ typedef enum { *result = npy_float_to_half((float)(value)) #elif defined(IS_CFLOAT) || defined(IS_CDOUBLE) || defined(IS_CLONGDOUBLE) #define CONVERT_TO_RESULT(value) \ - result->real = value; \ - result->imag = 0 + NPY_@TYPE@_GET_REAL(result) = value; \ + NPY_@TYPE@_GET_IMAG(result) = 0 #else #define CONVERT_TO_RESULT(value) *result = value #endif @@ -888,8 +890,8 @@ typedef enum { case NPY_##OTHER: \ if (IS_SAFE(NPY_##OTHER, NPY_@TYPE@)) { \ assert(Py_TYPE(value) == &Py##Other##ArrType_Type); \ - result->real = PyArrayScalar_VAL(value, Other).real; \ - result->imag = PyArrayScalar_VAL(value, Other).imag; \ + NPY_@TYPE@_GET_REAL(result) = NPY_##OTHER##_GET_REAL(&PyArrayScalar_VAL(value, Other)); \ + NPY_@TYPE@_GET_IMAG(result) = NPY_##OTHER##_GET_IMAG(&PyArrayScalar_VAL(value, Other)); \ ret = 1; \ } \ else if (IS_SAFE(NPY_@TYPE@, NPY_##OTHER)) { \ @@ -1040,8 +1042,8 @@ convert_to_@name@(PyObject *value, @type@ *result, npy_bool *may_need_deferring) if (error_converting(val.real)) { return CONVERSION_ERROR; /* should not be possible */ } - result->real = val.real; - result->imag = val.imag; + NPY_@TYPE@_GET_REAL(result) = val.real; + NPY_@TYPE@_GET_IMAG(result) = val.imag; return CONVERSION_SUCCESS; #else /* unreachable, always unsafe cast above; return to avoid warning */ @@ -1665,6 +1667,10 @@ static PyObject * #define _IS_NONZERO(x) (x != 0) /**begin repeat * + * #NAME = BYTE, UBYTE, SHORT, USHORT, INT, + * UINT, LONG, ULONG, LONGLONG, ULONGLONG, + * HALF, FLOAT, DOUBLE, LONGDOUBLE, + * CFLOAT, CDOUBLE, CLONGDOUBLE# * #name = byte, ubyte, short, ushort, int, * uint, long, ulong, longlong, ulonglong, * half, float, double, longdouble, @@ -1691,7 +1697,7 @@ static int #if @simp@ ret = @nonzero@(val); #else - ret = (@nonzero@(val.real) || @nonzero@(val.imag)); + ret = (@nonzero@(NPY_@NAME@_GET_REAL(&val)) || @nonzero@(NPY_@NAME@_GET_IMAG(&val))); #endif return ret; @@ -1714,6 +1720,10 @@ emit_complexwarning(void) /**begin repeat * + * #NAME = BYTE, UBYTE, SHORT, USHORT, INT, + * UINT, LONG, ULONG, LONGLONG, ULONGLONG, + * HALF, FLOAT, DOUBLE, LONGDOUBLE, + * CFLOAT, CDOUBLE, CLONGDOUBLE# * #name = byte, ubyte, short, ushort, int, * uint, long, ulong, longlong, ulonglong, * half, float, double, longdouble, @@ -1740,7 +1750,7 @@ static PyObject * PyObject *long_result; #if @cmplx@ - @sign@ @ctype@ x = @to_ctype@(PyArrayScalar_VAL(obj, @Name@).real); + @sign@ @ctype@ x = @to_ctype@(NPY_@NAME@_GET_REAL(&PyArrayScalar_VAL(obj, @Name@))); #else @sign@ @ctype@ x = @to_ctype@(PyArrayScalar_VAL(obj, @Name@)); #endif @@ -1762,6 +1772,10 @@ static PyObject * /**begin repeat * + * #NAME = BYTE, UBYTE, SHORT, USHORT, INT, + * UINT, LONG, ULONG, LONGLONG, ULONGLONG, + * HALF, FLOAT, DOUBLE, LONGDOUBLE, + * CFLOAT, CDOUBLE, CLONGDOUBLE# * #name = byte, ubyte, short, ushort, int, uint, * long, ulong, longlong, ulonglong, * half, float, double, longdouble, @@ -1781,7 +1795,7 @@ static PyObject * if (emit_complexwarning() < 0) { return NULL; } - return @func@(@to_ctype@(PyArrayScalar_VAL(obj, @Name@).real)); + return @func@(@to_ctype@(NPY_@NAME@_GET_REAL(&PyArrayScalar_VAL(obj, @Name@)))); #else return @func@(@to_ctype@(PyArrayScalar_VAL(obj, @Name@))); #endif @@ -1801,9 +1815,15 @@ static PyObject * * npy_half_gt, npy_half_eq, npy_half_ne# */ #define def_cmp_@oper@(arg1, arg2) (arg1 @op@ arg2) -#define cmplx_cmp_@oper@(arg1, arg2) ((arg1.real == arg2.real) ? \ - arg1.imag @op@ arg2.imag : \ - arg1.real @op@ arg2.real) +#define cmplx_cmp_@oper@(arg1, arg2) ((NPY_CDOUBLE_GET_REAL(&arg1) == NPY_CDOUBLE_GET_REAL(&arg2)) ? \ + NPY_CDOUBLE_GET_IMAG(&arg1) @op@ NPY_CDOUBLE_GET_IMAG(&arg2) : \ + NPY_CDOUBLE_GET_REAL(&arg1) @op@ NPY_CDOUBLE_GET_REAL(&arg2)) +#define fcmplx_cmp_@oper@(arg1, arg2) ((NPY_CFLOAT_GET_REAL(&arg1) == NPY_CFLOAT_GET_REAL(&arg2)) ? \ + NPY_CFLOAT_GET_IMAG(&arg1) @op@ NPY_CFLOAT_GET_IMAG(&arg2) : \ + NPY_CFLOAT_GET_REAL(&arg1) @op@ NPY_CFLOAT_GET_REAL(&arg2)) +#define lcmplx_cmp_@oper@(arg1, arg2) ((NPY_CLONGDOUBLE_GET_REAL(&arg1) == NPY_CLONGDOUBLE_GET_REAL(&arg2)) ? \ + NPY_CLONGDOUBLE_GET_IMAG(&arg1) @op@ NPY_CLONGDOUBLE_GET_IMAG(&arg2) : \ + NPY_CLONGDOUBLE_GET_REAL(&arg1) @op@ NPY_CLONGDOUBLE_GET_REAL(&arg2)) #define def_half_cmp_@oper@(arg1, arg2) @halfop@(arg1, arg2) /**end repeat**/ @@ -1820,7 +1840,7 @@ static PyObject * * LONG, ULONG, LONGLONG, ULONGLONG, * HALF, FLOAT, DOUBLE, LONGDOUBLE, * CFLOAT, CDOUBLE, CLONGDOUBLE# - * #simp = def*10, def_half, def*3, cmplx*3# + * #simp = def*10, def_half, def*3, fcmplx, cmplx, lcmplx# */ #define IS_@name@ diff --git a/numpy/linalg/umath_linalg.cpp b/numpy/linalg/umath_linalg.cpp index 68db2b2f1761..530e0ba02b9b 100644 --- a/numpy/linalg/umath_linalg.cpp +++ b/numpy/linalg/umath_linalg.cpp @@ -1046,8 +1046,10 @@ det_from_slogdet(typ sign, typ logdet) npy_float npyabs(npy_cfloat z) { return npy_cabsf(z);} npy_double npyabs(npy_cdouble z) { return npy_cabs(z);} -#define RE(COMPLEX) (COMPLEX).real -#define IM(COMPLEX) (COMPLEX).imag +#define RE(COMPLEX) (COMPLEX).real() +#define IM(COMPLEX) (COMPLEX).imag() +#define SETRE(COMPLEX, VALUE) (COMPLEX).real(VALUE) +#define SETIM(COMPLEX, VALUE) (COMPLEX).imag(VALUE) template static inline typ @@ -1055,8 +1057,8 @@ mult(typ op1, typ op2) { typ rv; - RE(rv) = RE(op1)*RE(op2) - IM(op1)*IM(op2); - IM(rv) = RE(op1)*IM(op2) + IM(op1)*RE(op2); + SETRE(rv, RE(op1)*RE(op2) - IM(op1)*IM(op2)); + SETIM(rv, RE(op1)*IM(op2) + IM(op1)*RE(op2)); return rv; } @@ -1077,8 +1079,8 @@ slogdet_from_factored_diagonal(typ* src, { basetyp abs_element = npyabs(*src); typ sign_element; - RE(sign_element) = RE(*src) / abs_element; - IM(sign_element) = IM(*src) / abs_element; + SETRE(sign_element, RE(*src) / abs_element); + SETIM(sign_element, IM(*src) / abs_element); sign_acc = mult(sign_acc, sign_element); logdet_acc += npylog(abs_element); @@ -1094,12 +1096,14 @@ static inline typ det_from_slogdet(typ sign, basetyp logdet) { typ tmp; - RE(tmp) = npyexp(logdet); - IM(tmp) = numeric_limits::zero; + SETRE(tmp, npyexp(logdet)); + SETIM(tmp, numeric_limits::zero); return mult(sign, tmp); } #undef RE #undef IM +#undef SETRE +#undef SETIM /* As in the linalg package, the determinant is computed via LU factorization @@ -3982,7 +3986,7 @@ abs2(typ *p, npy_intp n, complex_trait) { basetype_t res = 0; for (i = 0; i < n; i++) { typ el = p[i]; - res += el.real*el.real + el.imag*el.imag; + res += el.real()*el.real() + el.imag()*el.imag(); } return res; } From 9eb70535617ab642ba1c567e45105706ff759e21 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Wed, 21 Jun 2023 18:09:44 +0200 Subject: [PATCH 02/40] Format --- numpy/core/include/numpy/ndarraytypes.h | 26 +++++++++++++++---------- numpy/core/src/common/cblasfuncs.c | 12 ++++++++---- 2 files changed, 24 insertions(+), 14 deletions(-) diff --git a/numpy/core/include/numpy/ndarraytypes.h b/numpy/core/include/numpy/ndarraytypes.h index d267acfbcf76..00cbac1bcbe7 100644 --- a/numpy/core/include/numpy/ndarraytypes.h +++ b/numpy/core/include/numpy/ndarraytypes.h @@ -962,16 +962,22 @@ typedef int (PyArray_FinalizeFunc)(PyArrayObject *, PyObject *); #define PyArray_MAX(a,b) (((a)>(b))?(a):(b)) #define PyArray_MIN(a,b) (((a)<(b))?(a):(b)) -#define PyArray_CLT(p,q, type) (((NPY_##type##_GET_REAL(&p)==NPY_##type##_GET_REAL(&q)) ? (NPY_##type##_GET_IMAG(&p) < NPY_##type##_GET_IMAG(&q)) : \ - (NPY_##type##_GET_REAL(&p) < NPY_##type##_GET_REAL(&q)))) -#define PyArray_CGT(p,q, type) (((NPY_##type##_GET_REAL(&p)==NPY_##type##_GET_REAL(&q)) ? (NPY_##type##_GET_IMAG(&p) > NPY_##type##_GET_IMAG(&q)) : \ - (NPY_##type##_GET_REAL(&p) > NPY_##type##_GET_REAL(&q)))) -#define PyArray_CLE(p,q, type) (((NPY_##type##_GET_REAL(&p)==NPY_##type##_GET_REAL(&q)) ? (NPY_##type##_GET_IMAG(&p) <= NPY_##type##_GET_IMAG(&q)) : \ - (NPY_##type##_GET_REAL(&p) <= NPY_##type##_GET_REAL(&q)))) -#define PyArray_CGE(p,q, type) (((NPY_##type##_GET_REAL(&p)==NPY_##type##_GET_REAL(&q)) ? (NPY_##type##_GET_IMAG(&p) >= NPY_##type##_GET_IMAG(&q)) : \ - (NPY_##type##_GET_REAL(&p) >= NPY_##type##_GET_REAL(&q)))) -#define PyArray_CEQ(p,q, type) ((NPY_##type##_GET_REAL(&p)==NPY_##type##_GET_REAL(&q)) && (NPY_##type##_GET_IMAG(&p) == NPY_##type##_GET_IMAG(&q))) -#define PyArray_CNE(p,q, type) ((NPY_##type##_GET_REAL(&p)!=NPY_##type##_GET_REAL(&q)) || (NPY_##type##_GET_IMAG(&p) != NPY_##type##_GET_IMAG(&q))) +#define PyArray_CLT(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ + ? NPY_##type##_GET_IMAG(&(p)) < NPY_##type##_GET_IMAG(&(q)) \ + : NPY_##type##_GET_REAL(&(p)) < NPY_##type##_GET_REAL(&(q)) +#define PyArray_CGT(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ + ? NPY_##type##_GET_IMAG(&(p)) > NPY_##type##_GET_IMAG(&(q)) \ + : NPY_##type##_GET_REAL(&(p)) > NPY_##type##_GET_REAL(&(q)) +#define PyArray_CLE(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ + ? NPY_##type##_GET_IMAG(&(p)) <= NPY_##type##_GET_IMAG(&(q)) \ + : NPY_##type##_GET_REAL(&(p)) <= NPY_##type##_GET_REAL(&(q)) +#define PyArray_CGE(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ + ? NPY_##type##_GET_IMAG(&(p)) >= NPY_##type##_GET_IMAG(&(q)) \ + : NPY_##type##_GET_REAL(&(p)) >= NPY_##type##_GET_REAL(&(q)) +#define PyArray_CEQ(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ + && NPY_##type##_GET_IMAG(&(p)) == NPY_##type##_GET_IMAG(&(q)) +#define PyArray_CNE(p,q, type) NPY_##type##_GET_REAL(&(p)) != NPY_##type##_GET_REAL(&(q)) \ + || NPY_##type##_GET_IMAG(&(p)) != NPY_##type##_GET_IMAG(&(q)) /* * C API: consists of Macros and functions. The MACROS are defined diff --git a/numpy/core/src/common/cblasfuncs.c b/numpy/core/src/common/cblasfuncs.c index 54053ed3cc2a..aa1d1a5b26c3 100644 --- a/numpy/core/src/common/cblasfuncs.c +++ b/numpy/core/src/common/cblasfuncs.c @@ -422,8 +422,10 @@ cblas_matrixproduct(int typenum, PyArrayObject *ap1, PyArrayObject *ap2, ptr1 = (npy_cdouble *)PyArray_DATA(ap2); ptr2 = (npy_cdouble *)PyArray_DATA(ap1); res = (npy_cdouble *)PyArray_DATA(out_buf); - NPY_CDOUBLE_GET_REAL(res) = NPY_CDOUBLE_GET_REAL(ptr1) * NPY_CDOUBLE_GET_REAL(ptr2) - NPY_CDOUBLE_GET_IMAG(ptr1) * NPY_CDOUBLE_GET_IMAG(ptr2); - NPY_CDOUBLE_GET_IMAG(res) = NPY_CDOUBLE_GET_REAL(ptr1) * NPY_CDOUBLE_GET_IMAG(ptr2) + NPY_CDOUBLE_GET_IMAG(ptr1) * NPY_CDOUBLE_GET_REAL(ptr2); + NPY_CDOUBLE_GET_REAL(res) = NPY_CDOUBLE_GET_REAL(ptr1) * NPY_CDOUBLE_GET_REAL(ptr2) + - NPY_CDOUBLE_GET_IMAG(ptr1) * NPY_CDOUBLE_GET_IMAG(ptr2); + NPY_CDOUBLE_GET_IMAG(res) = NPY_CDOUBLE_GET_REAL(ptr1) * NPY_CDOUBLE_GET_IMAG(ptr2) + + NPY_CDOUBLE_GET_IMAG(ptr1) * NPY_CDOUBLE_GET_REAL(ptr2); } else if (ap1shape != _matrix) { CBLAS_FUNC(cblas_zaxpy)(l, @@ -495,8 +497,10 @@ cblas_matrixproduct(int typenum, PyArrayObject *ap1, PyArrayObject *ap2, ptr1 = (npy_cfloat *)PyArray_DATA(ap2); ptr2 = (npy_cfloat *)PyArray_DATA(ap1); res = (npy_cfloat *)PyArray_DATA(out_buf); - NPY_CFLOAT_GET_REAL(res) = NPY_CFLOAT_GET_REAL(ptr1) * NPY_CFLOAT_GET_REAL(ptr2) - NPY_CFLOAT_GET_IMAG(ptr1) * NPY_CFLOAT_GET_IMAG(ptr2); - NPY_CFLOAT_GET_IMAG(res) = NPY_CFLOAT_GET_REAL(ptr1) * NPY_CFLOAT_GET_IMAG(ptr2) + NPY_CFLOAT_GET_IMAG(ptr1) * NPY_CFLOAT_GET_REAL(ptr2); + NPY_CFLOAT_GET_REAL(res) = NPY_CFLOAT_GET_REAL(ptr1) * NPY_CFLOAT_GET_REAL(ptr2) + - NPY_CFLOAT_GET_IMAG(ptr1) * NPY_CFLOAT_GET_IMAG(ptr2); + NPY_CFLOAT_GET_IMAG(res) = NPY_CFLOAT_GET_REAL(ptr1) * NPY_CFLOAT_GET_IMAG(ptr2) + + NPY_CFLOAT_GET_IMAG(ptr1) * NPY_CFLOAT_GET_REAL(ptr2); } else if (ap1shape != _matrix) { CBLAS_FUNC(cblas_caxpy)(l, From d2b55127404b6ba28360afa0b5c4e852089e5623 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Thu, 22 Jun 2023 14:55:23 +0200 Subject: [PATCH 03/40] Fix f2py --- numpy/f2py/cfuncs.py | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/numpy/f2py/cfuncs.py b/numpy/f2py/cfuncs.py index 2d27b652432b..72d492b487d3 100644 --- a/numpy/f2py/cfuncs.py +++ b/numpy/f2py/cfuncs.py @@ -1108,8 +1108,8 @@ return 1; } else if (PyArray_Check(obj) && PyArray_TYPE(obj)==NPY_CLONGDOUBLE) { - (*v).r = ((npy_clongdouble *)PyArray_DATA(obj))->real; - (*v).i = ((npy_clongdouble *)PyArray_DATA(obj))->imag; + (*v).r = NPY_CLONGDOUBLE_GET_REAL(((npy_clongdouble *)PyArray_DATA(obj))); + (*v).i = NPY_CLONGDOUBLE_GET_IMAG(((npy_clongdouble *)PyArray_DATA(obj))); return 1; } } @@ -1138,14 +1138,14 @@ if (PyArray_IsScalar(obj, CFloat)) { npy_cfloat new; PyArray_ScalarAsCtype(obj, &new); - (*v).r = (double)new.real; - (*v).i = (double)new.imag; + (*v).r = (double)NPY_CFLOAT_GET_REAL(&new); + (*v).i = (double)NPY_CFLOAT_GET_IMAG(&new); } else if (PyArray_IsScalar(obj, CLongDouble)) { npy_clongdouble new; PyArray_ScalarAsCtype(obj, &new); - (*v).r = (double)new.real; - (*v).i = (double)new.imag; + (*v).r = (double)NPY_CLONGDOUBLE_GET_REAL(&new); + (*v).i = (double)NPY_CLONGDOUBLE_GET_IMAG(&new); } else { /* if (PyArray_IsScalar(obj, CDouble)) */ PyArray_ScalarAsCtype(obj, v); @@ -1163,8 +1163,8 @@ if (arr == NULL) { return 0; } - (*v).r = ((npy_cdouble *)PyArray_DATA(arr))->real; - (*v).i = ((npy_cdouble *)PyArray_DATA(arr))->imag; + (*v).r = NPY_CDOUBLE_GET_REAL(((npy_cdouble *)PyArray_DATA(arr))); + (*v).i = NPY_CDOUBLE_GET_IMAG(((npy_cdouble *)PyArray_DATA(arr))); Py_DECREF(arr); return 1; } From 4a246bbae0265b31e167bfcf501a925f3ace25ce Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Thu, 29 Jun 2023 12:52:40 +0200 Subject: [PATCH 04/40] Rename complex to singlecomplex in all f2c'd files --- numpy/linalg/lapack_lite/f2c.c | 24 +- numpy/linalg/lapack_lite/f2c.h | 24 +- numpy/linalg/lapack_lite/f2c_blas.c | 154 +- numpy/linalg/lapack_lite/f2c_blas.c.patch | 2 +- numpy/linalg/lapack_lite/f2c_c_lapack.c | 1648 ++++++++++----------- numpy/linalg/lapack_lite/f2c_lapack.c | 4 +- 6 files changed, 928 insertions(+), 928 deletions(-) diff --git a/numpy/linalg/lapack_lite/f2c.c b/numpy/linalg/lapack_lite/f2c.c index ddaa8d17278c..47e4d5729b83 100644 --- a/numpy/linalg/lapack_lite/f2c.c +++ b/numpy/linalg/lapack_lite/f2c.c @@ -93,9 +93,9 @@ return(temp); VOID #ifdef KR_headers -r_cnjg(r, z) complex *r, *z; +r_cnjg(r, z) singlecomplex *r, *z; #else -r_cnjg(complex *r, complex *z) +r_cnjg(singlecomplex *r, singlecomplex *z) #endif { r->r = z->r; @@ -115,9 +115,9 @@ r->i = - z->i; #ifdef KR_headers -float r_imag(z) complex *z; +float r_imag(z) singlecomplex *z; #else -float r_imag(complex *z) +float r_imag(singlecomplex *z) #endif { return(z->i); @@ -343,10 +343,10 @@ void pow_zi(doublecomplex *p, doublecomplex *a, integer *b) /* p = a**b */ #ifdef KR_headers VOID pow_ci(p, a, b) /* p = a**b */ - complex *p, *a; integer *b; + singlecomplex *p, *a; integer *b; #else extern void pow_zi(doublecomplex*, doublecomplex*, integer*); -void pow_ci(complex *p, complex *a, integer *b) /* p = a**b */ +void pow_ci(singlecomplex *p, singlecomplex *a, integer *b) /* p = a**b */ #endif { doublecomplex p1, a1; @@ -536,10 +536,10 @@ int s_copy(register char *a, register char *b, ftnlen la, ftnlen lb) #ifdef KR_headers double f__cabsf(); -double c_abs(z) complex *z; +double c_abs(z) singlecomplex *z; #else double f__cabsf(float, float); -double c_abs(complex *z) +double c_abs(singlecomplex *z) #endif { return( f__cabsf( z->r, z->i ) ); @@ -559,10 +559,10 @@ return( f__cabs( z->r, z->i ) ); #ifdef KR_headers extern void sig_die(); -VOID c_div(c, a, b) complex *a, *b, *c; +VOID c_div(c, a, b) singlecomplex *a, *b, *c; #else extern void sig_die(char*, int); -void c_div(complex *c, complex *a, complex *b) +void c_div(singlecomplex *c, singlecomplex *a, singlecomplex *b) #endif { float ratio, den; @@ -632,12 +632,12 @@ else #ifdef KR_headers float sqrtf(), f__cabsf(); -VOID c_sqrt(r, z) complex *r, *z; +VOID c_sqrt(r, z) singlecomplex *r, *z; #else #undef abs extern double f__cabsf(float, float); -void c_sqrt(complex *r, complex *z) +void c_sqrt(singlecomplex *r, singlecomplex *z) #endif { float mag; diff --git a/numpy/linalg/lapack_lite/f2c.h b/numpy/linalg/lapack_lite/f2c.h index 0db1b9ecb545..60bce4a9f575 100644 --- a/numpy/linalg/lapack_lite/f2c.h +++ b/numpy/linalg/lapack_lite/f2c.h @@ -21,7 +21,7 @@ typedef char *address; typedef short int shortint; typedef float real; typedef double doublereal; -typedef struct { real r, i; } complex; +typedef struct { real r, i; } singlecomplex; typedef struct { doublereal r, i; } doublecomplex; typedef CBLAS_INT logical; typedef short int shortlogical; @@ -131,7 +131,7 @@ union Multitype { /* for multiple entry points */ integer i; real r; doublereal d; - complex c; + singlecomplex c; doublecomplex z; }; @@ -234,13 +234,13 @@ extern "C" { #endif extern int abort_(void); -extern double c_abs(complex *); -extern void c_cos(complex *, complex *); -extern void c_div(complex *, complex *, complex *); -extern void c_exp(complex *, complex *); -extern void c_log(complex *, complex *); -extern void c_sin(complex *, complex *); -extern void c_sqrt(complex *, complex *); +extern double c_abs(singlecomplex *); +extern void c_cos(singlecomplex *, singlecomplex *); +extern void c_div(singlecomplex *, singlecomplex *, singlecomplex *); +extern void c_exp(singlecomplex *, singlecomplex *); +extern void c_log(singlecomplex *, singlecomplex *); +extern void c_sin(singlecomplex *, singlecomplex *); +extern void c_sqrt(singlecomplex *, singlecomplex *); extern double d_abs(double *); extern double d_acos(double *); extern double d_asin(double *); @@ -323,7 +323,7 @@ extern ftnlen l_ge(char *, char *, ftnlen, ftnlen); extern ftnlen l_gt(char *, char *, ftnlen, ftnlen); extern ftnlen l_le(char *, char *, ftnlen, ftnlen); extern ftnlen l_lt(char *, char *, ftnlen, ftnlen); -extern void pow_ci(complex *, complex *, integer *); +extern void pow_ci(singlecomplex *, singlecomplex *, integer *); extern double pow_dd(double *, double *); extern double pow_di(double *, integer *); extern short pow_hh(short *, shortint *); @@ -336,12 +336,12 @@ extern double r_acos(float *); extern double r_asin(float *); extern double r_atan(float *); extern double r_atn2(float *, float *); -extern void r_cnjg(complex *, complex *); +extern void r_cnjg(singlecomplex *, singlecomplex *); extern double r_cos(float *); extern double r_cosh(float *); extern double r_dim(float *, float *); extern double r_exp(float *); -extern float r_imag(complex *); +extern float r_imag(singlecomplex *); extern double r_int(float *); extern float r_lg10(real *); extern double r_log(float *); diff --git a/numpy/linalg/lapack_lite/f2c_blas.c b/numpy/linalg/lapack_lite/f2c_blas.c index 9a9fd3f9b917..f8aa5301608b 100644 --- a/numpy/linalg/lapack_lite/f2c_blas.c +++ b/numpy/linalg/lapack_lite/f2c_blas.c @@ -29,19 +29,19 @@ them. /* Table of constant values */ -static complex c_b21 = {1.f,0.f}; +static singlecomplex c_b21 = {1.f,0.f}; static doublecomplex c_b1078 = {1.,0.}; -/* Subroutine */ int caxpy_(integer *n, complex *ca, complex *cx, integer * - incx, complex *cy, integer *incy) +/* Subroutine */ int caxpy_(integer *n, singlecomplex *ca, singlecomplex *cx, integer * + incx, singlecomplex *cy, integer *incy) { /* System generated locals */ integer i__1, i__2, i__3, i__4; - complex q__1, q__2; + singlecomplex q__1, q__2; /* Local variables */ static integer i__, ix, iy; - extern doublereal scabs1_(complex *); + extern doublereal scabs1_(singlecomplex *); /* @@ -119,7 +119,7 @@ static doublecomplex c_b1078 = {1.,0.}; return 0; } /* caxpy_ */ -/* Subroutine */ int ccopy_(integer *n, complex *cx, integer *incx, complex * +/* Subroutine */ int ccopy_(integer *n, singlecomplex *cx, integer *incx, singlecomplex * cy, integer *incy) { /* System generated locals */ @@ -193,16 +193,16 @@ static doublecomplex c_b1078 = {1.,0.}; return 0; } /* ccopy_ */ -/* Complex */ VOID cdotc_(complex * ret_val, integer *n, complex *cx, integer - *incx, complex *cy, integer *incy) +/* Complex */ VOID cdotc_(singlecomplex * ret_val, integer *n, singlecomplex *cx, integer + *incx, singlecomplex *cy, integer *incy) { /* System generated locals */ integer i__1, i__2; - complex q__1, q__2, q__3; + singlecomplex q__1, q__2, q__3; /* Local variables */ static integer i__, ix, iy; - static complex ctemp; + static singlecomplex ctemp; /* @@ -280,16 +280,16 @@ static doublecomplex c_b1078 = {1.,0.}; return ; } /* cdotc_ */ -/* Complex */ VOID cdotu_(complex * ret_val, integer *n, complex *cx, integer - *incx, complex *cy, integer *incy) +/* Complex */ VOID cdotu_(singlecomplex * ret_val, integer *n, singlecomplex *cx, integer + *incx, singlecomplex *cy, integer *incy) { /* System generated locals */ integer i__1, i__2, i__3; - complex q__1, q__2; + singlecomplex q__1, q__2; /* Local variables */ static integer i__, ix, iy; - static complex ctemp; + static singlecomplex ctemp; /* @@ -367,18 +367,18 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cdotu_ */ /* Subroutine */ int cgemm_(char *transa, char *transb, integer *m, integer * - n, integer *k, complex *alpha, complex *a, integer *lda, complex *b, - integer *ldb, complex *beta, complex *c__, integer *ldc) + n, integer *k, singlecomplex *alpha, singlecomplex *a, integer *lda, singlecomplex *b, + integer *ldb, singlecomplex *beta, singlecomplex *c__, integer *ldc) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6; - complex q__1, q__2, q__3, q__4; + singlecomplex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__, j, l, info; static logical nota, notb; - static complex temp; + static singlecomplex temp; static logical conja, conjb; extern logical lsame_(char *, char *); static integer nrowa, nrowb; @@ -1034,17 +1034,17 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cgemm_ */ -/* Subroutine */ int cgemv_(char *trans, integer *m, integer *n, complex * - alpha, complex *a, integer *lda, complex *x, integer *incx, complex * - beta, complex *y, integer *incy) +/* Subroutine */ int cgemv_(char *trans, integer *m, integer *n, singlecomplex * + alpha, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx, singlecomplex * + beta, singlecomplex *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - complex q__1, q__2, q__3; + singlecomplex q__1, q__2, q__3; /* Local variables */ static integer i__, j, ix, iy, jx, jy, kx, ky, info; - static complex temp; + static singlecomplex temp; static integer lenx, leny; extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); @@ -1423,16 +1423,16 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cgemv_ */ -/* Subroutine */ int cgerc_(integer *m, integer *n, complex *alpha, complex * - x, integer *incx, complex *y, integer *incy, complex *a, integer *lda) +/* Subroutine */ int cgerc_(integer *m, integer *n, singlecomplex *alpha, singlecomplex * + x, integer *incx, singlecomplex *y, integer *incy, singlecomplex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - complex q__1, q__2; + singlecomplex q__1, q__2; /* Local variables */ static integer i__, j, ix, jy, kx, info; - static complex temp; + static singlecomplex temp; extern /* Subroutine */ int xerbla_(char *, integer *); @@ -1618,16 +1618,16 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cgerc_ */ -/* Subroutine */ int cgeru_(integer *m, integer *n, complex *alpha, complex * - x, integer *incx, complex *y, integer *incy, complex *a, integer *lda) +/* Subroutine */ int cgeru_(integer *m, integer *n, singlecomplex *alpha, singlecomplex * + x, integer *incx, singlecomplex *y, integer *incy, singlecomplex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - complex q__1, q__2; + singlecomplex q__1, q__2; /* Local variables */ static integer i__, j, ix, jy, kx, info; - static complex temp; + static singlecomplex temp; extern /* Subroutine */ int xerbla_(char *, integer *); @@ -1813,18 +1813,18 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cgeru_ */ -/* Subroutine */ int chemv_(char *uplo, integer *n, complex *alpha, complex * - a, integer *lda, complex *x, integer *incx, complex *beta, complex *y, +/* Subroutine */ int chemv_(char *uplo, integer *n, singlecomplex *alpha, singlecomplex * + a, integer *lda, singlecomplex *x, integer *incx, singlecomplex *beta, singlecomplex *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; real r__1; - complex q__1, q__2, q__3, q__4; + singlecomplex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__, j, ix, iy, jx, jy, kx, ky, info; - static complex temp1, temp2; + static singlecomplex temp1, temp2; extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); @@ -2222,17 +2222,17 @@ static doublecomplex c_b1078 = {1.,0.}; } /* chemv_ */ -/* Subroutine */ int cher2_(char *uplo, integer *n, complex *alpha, complex * - x, integer *incx, complex *y, integer *incy, complex *a, integer *lda) +/* Subroutine */ int cher2_(char *uplo, integer *n, singlecomplex *alpha, singlecomplex * + x, integer *incx, singlecomplex *y, integer *incy, singlecomplex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6; real r__1; - complex q__1, q__2, q__3, q__4; + singlecomplex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__, j, ix, iy, jx, jy, kx, ky, info; - static complex temp1, temp2; + static singlecomplex temp1, temp2; extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); @@ -2647,18 +2647,18 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cher2_ */ /* Subroutine */ int cher2k_(char *uplo, char *trans, integer *n, integer *k, - complex *alpha, complex *a, integer *lda, complex *b, integer *ldb, - real *beta, complex *c__, integer *ldc) + singlecomplex *alpha, singlecomplex *a, integer *lda, singlecomplex *b, integer *ldb, + real *beta, singlecomplex *c__, integer *ldc) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; real r__1; - complex q__1, q__2, q__3, q__4, q__5, q__6; + singlecomplex q__1, q__2, q__3, q__4, q__5, q__6; /* Local variables */ static integer i__, j, l, info; - static complex temp1, temp2; + static singlecomplex temp1, temp2; extern logical lsame_(char *, char *); static integer nrowa; static logical upper; @@ -3296,18 +3296,18 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cher2k_ */ /* Subroutine */ int cherk_(char *uplo, char *trans, integer *n, integer *k, - real *alpha, complex *a, integer *lda, real *beta, complex *c__, + real *alpha, singlecomplex *a, integer *lda, real *beta, singlecomplex *c__, integer *ldc) { /* System generated locals */ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6; real r__1; - complex q__1, q__2, q__3; + singlecomplex q__1, q__2, q__3; /* Local variables */ static integer i__, j, l, info; - static complex temp; + static singlecomplex temp; extern logical lsame_(char *, char *); static integer nrowa; static real rtemp; @@ -3802,12 +3802,12 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cherk_ */ -/* Subroutine */ int cscal_(integer *n, complex *ca, complex *cx, integer * +/* Subroutine */ int cscal_(integer *n, singlecomplex *ca, singlecomplex *cx, integer * incx) { /* System generated locals */ integer i__1, i__2, i__3, i__4; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, nincx; @@ -3870,16 +3870,16 @@ static doublecomplex c_b1078 = {1.,0.}; return 0; } /* cscal_ */ -/* Subroutine */ int csrot_(integer *n, complex *cx, integer *incx, complex * +/* Subroutine */ int csrot_(integer *n, singlecomplex *cx, integer *incx, singlecomplex * cy, integer *incy, real *c__, real *s) { /* System generated locals */ integer i__1, i__2, i__3, i__4; - complex q__1, q__2, q__3; + singlecomplex q__1, q__2, q__3; /* Local variables */ static integer i__, ix, iy; - static complex ctemp; + static singlecomplex ctemp; /* @@ -3887,7 +3887,7 @@ static doublecomplex c_b1078 = {1.,0.}; ======= CSROT applies a plane rotation, where the cos and sin (c and s) are real - and the vectors cx and cy are complex. + and the vectors cx and cy are singlecomplex. jack dongarra, linpack, 3/11/78. Arguments @@ -4005,12 +4005,12 @@ static doublecomplex c_b1078 = {1.,0.}; return 0; } /* csrot_ */ -/* Subroutine */ int csscal_(integer *n, real *sa, complex *cx, integer *incx) +/* Subroutine */ int csscal_(integer *n, real *sa, singlecomplex *cx, integer *incx) { /* System generated locals */ integer i__1, i__2, i__3, i__4; real r__1, r__2; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, nincx; @@ -4020,7 +4020,7 @@ static doublecomplex c_b1078 = {1.,0.}; Purpose ======= - CSSCAL scales a complex vector by a real constant. + CSSCAL scales a singlecomplex vector by a real constant. Further Details =============== @@ -4075,7 +4075,7 @@ static doublecomplex c_b1078 = {1.,0.}; return 0; } /* csscal_ */ -/* Subroutine */ int cswap_(integer *n, complex *cx, integer *incx, complex * +/* Subroutine */ int cswap_(integer *n, singlecomplex *cx, integer *incx, singlecomplex * cy, integer *incy) { /* System generated locals */ @@ -4083,7 +4083,7 @@ static doublecomplex c_b1078 = {1.,0.}; /* Local variables */ static integer i__, ix, iy; - static complex ctemp; + static singlecomplex ctemp; /* @@ -4158,17 +4158,17 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cswap_ */ /* Subroutine */ int ctrmm_(char *side, char *uplo, char *transa, char *diag, - integer *m, integer *n, complex *alpha, complex *a, integer *lda, - complex *b, integer *ldb) + integer *m, integer *n, singlecomplex *alpha, singlecomplex *a, integer *lda, + singlecomplex *b, integer *ldb) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5, i__6; - complex q__1, q__2, q__3; + singlecomplex q__1, q__2, q__3; /* Local variables */ static integer i__, j, k, info; - static complex temp; + static singlecomplex temp; extern logical lsame_(char *, char *); static logical lside; static integer nrowa; @@ -4820,15 +4820,15 @@ static doublecomplex c_b1078 = {1.,0.}; } /* ctrmm_ */ /* Subroutine */ int ctrmv_(char *uplo, char *trans, char *diag, integer *n, - complex *a, integer *lda, complex *x, integer *incx) + singlecomplex *a, integer *lda, singlecomplex *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - complex q__1, q__2, q__3; + singlecomplex q__1, q__2, q__3; /* Local variables */ static integer i__, j, ix, jx, kx, info; - static complex temp; + static singlecomplex temp; extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); static logical noconj, nounit; @@ -5352,17 +5352,17 @@ static doublecomplex c_b1078 = {1.,0.}; } /* ctrmv_ */ /* Subroutine */ int ctrsm_(char *side, char *uplo, char *transa, char *diag, - integer *m, integer *n, complex *alpha, complex *a, integer *lda, - complex *b, integer *ldb) + integer *m, integer *n, singlecomplex *alpha, singlecomplex *a, integer *lda, + singlecomplex *b, integer *ldb) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; - complex q__1, q__2, q__3; + singlecomplex q__1, q__2, q__3; /* Local variables */ static integer i__, j, k, info; - static complex temp; + static singlecomplex temp; extern logical lsame_(char *, char *); static logical lside; static integer nrowa; @@ -6024,15 +6024,15 @@ static doublecomplex c_b1078 = {1.,0.}; } /* ctrsm_ */ /* Subroutine */ int ctrsv_(char *uplo, char *trans, char *diag, integer *n, - complex *a, integer *lda, complex *x, integer *incx) + singlecomplex *a, integer *lda, singlecomplex *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - complex q__1, q__2, q__3; + singlecomplex q__1, q__2, q__3; /* Local variables */ static integer i__, j, ix, jx, kx, info; - static complex temp; + static singlecomplex temp; extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); static logical noconj, nounit; @@ -10658,7 +10658,7 @@ doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx) } /* dznrm2_ */ -integer icamax_(integer *n, complex *cx, integer *incx) +integer icamax_(integer *n, singlecomplex *cx, integer *incx) { /* System generated locals */ integer ret_val, i__1; @@ -10666,7 +10666,7 @@ integer icamax_(integer *n, complex *cx, integer *incx) /* Local variables */ static integer i__, ix; static real smax; - extern doublereal scabs1_(complex *); + extern doublereal scabs1_(singlecomplex *); /* @@ -11066,7 +11066,7 @@ integer izamax_(integer *n, doublecomplex *zx, integer *incx) return 0; } /* saxpy_ */ -doublereal scabs1_(complex *z__) +doublereal scabs1_(singlecomplex *z__) { /* System generated locals */ real ret_val, r__1, r__2; @@ -11085,7 +11085,7 @@ doublereal scabs1_(complex *z__) return ret_val; } /* scabs1_ */ -doublereal scasum_(integer *n, complex *cx, integer *incx) +doublereal scasum_(integer *n, singlecomplex *cx, integer *incx) { /* System generated locals */ integer i__1, i__2, i__3; @@ -11100,7 +11100,7 @@ doublereal scasum_(integer *n, complex *cx, integer *incx) Purpose ======= - SCASUM takes the sum of the absolute values of a complex vector and + SCASUM takes the sum of the absolute values of a singlecomplex vector and returns a single precision result. Further Details @@ -11154,7 +11154,7 @@ doublereal scasum_(integer *n, complex *cx, integer *incx) return ret_val; } /* scasum_ */ -doublereal scnrm2_(integer *n, complex *x, integer *incx) +doublereal scnrm2_(integer *n, singlecomplex *x, integer *incx) { /* System generated locals */ integer i__1, i__2, i__3; diff --git a/numpy/linalg/lapack_lite/f2c_blas.c.patch b/numpy/linalg/lapack_lite/f2c_blas.c.patch index 59a6a1919b11..4ba3fe3cc66b 100644 --- a/numpy/linalg/lapack_lite/f2c_blas.c.patch +++ b/numpy/linalg/lapack_lite/f2c_blas.c.patch @@ -1,6 +1,6 @@ @@ -380,7 +380,6 @@ L20: static logical nota, notb; - static complex temp; + static singlecomplex temp; static logical conja, conjb; - static integer ncola; extern logical lsame_(char *, char *); diff --git a/numpy/linalg/lapack_lite/f2c_c_lapack.c b/numpy/linalg/lapack_lite/f2c_c_lapack.c index a7d1f836b613..5d456609bdf7 100644 --- a/numpy/linalg/lapack_lite/f2c_c_lapack.c +++ b/numpy/linalg/lapack_lite/f2c_c_lapack.c @@ -30,8 +30,8 @@ them. /* Table of constant values */ static integer c__1 = 1; -static complex c_b56 = {0.f,0.f}; -static complex c_b57 = {1.f,0.f}; +static singlecomplex c_b56 = {0.f,0.f}; +static singlecomplex c_b57 = {1.f,0.f}; static integer c_n1 = -1; static integer c__3 = 3; static integer c__2 = 2; @@ -53,7 +53,7 @@ static logical c_true = TRUE_; static real c_b2435 = .5f; /* Subroutine */ int cgebak_(char *job, char *side, integer *n, integer *ilo, - integer *ihi, real *scale, integer *m, complex *v, integer *ldv, + integer *ihi, real *scale, integer *m, singlecomplex *v, integer *ldv, integer *info) { /* System generated locals */ @@ -64,10 +64,10 @@ static real c_b2435 = .5f; static real s; static integer ii; extern logical lsame_(char *, char *); - extern /* Subroutine */ int cswap_(integer *, complex *, integer *, - complex *, integer *); + extern /* Subroutine */ int cswap_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *); static logical leftv; - extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer + extern /* Subroutine */ int csscal_(integer *, real *, singlecomplex *, integer *), xerbla_(char *, integer *); static logical rightv; @@ -82,7 +82,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEBAK forms the right or left eigenvectors of a complex general + CGEBAK forms the right or left eigenvectors of a singlecomplex general matrix by backward transformation on the computed eigenvectors of the balanced matrix output by CGEBAL. @@ -264,7 +264,7 @@ static real c_b2435 = .5f; } /* cgebak_ */ -/* Subroutine */ int cgebal_(char *job, integer *n, complex *a, integer *lda, +/* Subroutine */ int cgebal_(char *job, integer *n, singlecomplex *a, integer *lda, integer *ilo, integer *ihi, real *scale, integer *info) { /* System generated locals */ @@ -277,12 +277,12 @@ static real c_b2435 = .5f; static real r__, s, ca, ra; static integer ica, ira, iexc; extern logical lsame_(char *, char *); - extern /* Subroutine */ int cswap_(integer *, complex *, integer *, - complex *, integer *); + extern /* Subroutine */ int cswap_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *); static real sfmin1, sfmin2, sfmax1, sfmax2; - extern integer icamax_(integer *, complex *, integer *); + extern integer icamax_(integer *, singlecomplex *, integer *); extern doublereal slamch_(char *); - extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer + extern /* Subroutine */ int csscal_(integer *, real *, singlecomplex *, integer *), xerbla_(char *, integer *); extern logical sisnan_(real *); static logical noconv; @@ -298,7 +298,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEBAL balances a general complex matrix A. This involves, first, + CGEBAL balances a general singlecomplex matrix A. This involves, first, permuting A by a similarity transformation to isolate eigenvalues in the first 1 to ILO-1 and last IHI+1 to N elements on the diagonal; and second, applying a diagonal similarity transformation @@ -654,21 +654,21 @@ static real c_b2435 = .5f; } /* cgebal_ */ -/* Subroutine */ int cgebd2_(integer *m, integer *n, complex *a, integer *lda, - real *d__, real *e, complex *tauq, complex *taup, complex *work, +/* Subroutine */ int cgebd2_(integer *m, integer *n, singlecomplex *a, integer *lda, + real *d__, real *e, singlecomplex *tauq, singlecomplex *taup, singlecomplex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__; - static complex alpha; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * - , integer *, complex *, complex *, integer *, complex *), - clarfg_(integer *, complex *, complex *, integer *, complex *), - clacgv_(integer *, complex *, integer *), xerbla_(char *, integer + static singlecomplex alpha; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * + , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), + clarfg_(integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), + clacgv_(integer *, singlecomplex *, integer *), xerbla_(char *, integer *); @@ -682,7 +682,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEBD2 reduces a complex general m by n matrix A to upper or lower + CGEBD2 reduces a singlecomplex general m by n matrix A to upper or lower real bidiagonal form B by a unitary transformation: Q' * A * P = B. If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. @@ -755,7 +755,7 @@ static real c_b2435 = .5f; H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' - where tauq and taup are complex scalars, and v and u are complex + where tauq and taup are singlecomplex scalars, and v and u are singlecomplex vectors; v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n); tauq is stored in TAUQ(i) and taup in TAUP(i). @@ -768,7 +768,7 @@ static real c_b2435 = .5f; H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' - where tauq and taup are complex scalars, v and u are complex vectors; + where tauq and taup are singlecomplex scalars, v and u are singlecomplex vectors; v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i). @@ -972,27 +972,27 @@ static real c_b2435 = .5f; } /* cgebd2_ */ -/* Subroutine */ int cgebrd_(integer *m, integer *n, complex *a, integer *lda, - real *d__, real *e, complex *tauq, complex *taup, complex *work, +/* Subroutine */ int cgebrd_(integer *m, integer *n, singlecomplex *a, integer *lda, + real *d__, real *e, singlecomplex *tauq, singlecomplex *taup, singlecomplex *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; real r__1; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, j, nb, nx; static real ws; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, complex *, complex *, integer *, complex *, integer *, - complex *, complex *, integer *); + integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *); static integer nbmin, iinfo, minmn; - extern /* Subroutine */ int cgebd2_(integer *, integer *, complex *, - integer *, real *, real *, complex *, complex *, complex *, - integer *), clabrd_(integer *, integer *, integer *, complex *, - integer *, real *, real *, complex *, complex *, complex *, - integer *, complex *, integer *), xerbla_(char *, integer *); + extern /* Subroutine */ int cgebd2_(integer *, integer *, singlecomplex *, + integer *, real *, real *, singlecomplex *, singlecomplex *, singlecomplex *, + integer *), clabrd_(integer *, integer *, integer *, singlecomplex *, + integer *, real *, real *, singlecomplex *, singlecomplex *, singlecomplex *, + integer *, singlecomplex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static integer ldwrkx, ldwrky, lwkopt; @@ -1009,7 +1009,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEBRD reduces a general complex M-by-N matrix A to upper or lower + CGEBRD reduces a general singlecomplex M-by-N matrix A to upper or lower bidiagonal form B by a unitary transformation: Q**H * A * P = B. If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. @@ -1093,7 +1093,7 @@ static real c_b2435 = .5f; H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' - where tauq and taup are complex scalars, and v and u are complex + where tauq and taup are singlecomplex scalars, and v and u are singlecomplex vectors; v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n); tauq is stored in TAUQ(i) and taup in TAUP(i). @@ -1106,7 +1106,7 @@ static real c_b2435 = .5f; H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' - where tauq and taup are complex scalars, and v and u are complex + where tauq and taup are singlecomplex scalars, and v and u are singlecomplex vectors; v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i). @@ -1297,59 +1297,59 @@ static real c_b2435 = .5f; } /* cgebrd_ */ -/* Subroutine */ int cgeev_(char *jobvl, char *jobvr, integer *n, complex *a, - integer *lda, complex *w, complex *vl, integer *ldvl, complex *vr, - integer *ldvr, complex *work, integer *lwork, real *rwork, integer * +/* Subroutine */ int cgeev_(char *jobvl, char *jobvr, integer *n, singlecomplex *a, + integer *lda, singlecomplex *w, singlecomplex *vl, integer *ldvl, singlecomplex *vr, + integer *ldvr, singlecomplex *work, integer *lwork, real *rwork, integer * info) { /* System generated locals */ integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3; real r__1, r__2; - complex q__1, q__2; + singlecomplex q__1, q__2; /* Local variables */ static integer i__, k, ihi; static real scl; static integer ilo; static real dum[1], eps; - static complex tmp; + static singlecomplex tmp; static integer ibal; static char side[1]; static real anrm; static integer ierr, itau, iwrk, nout; - extern /* Subroutine */ int cscal_(integer *, complex *, complex *, + extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, integer *); extern logical lsame_(char *, char *); - extern doublereal scnrm2_(integer *, complex *, integer *); + extern doublereal scnrm2_(integer *, singlecomplex *, integer *); extern /* Subroutine */ int cgebak_(char *, char *, integer *, integer *, - integer *, real *, integer *, complex *, integer *, integer *), cgebal_(char *, integer *, complex *, integer *, + integer *, real *, integer *, singlecomplex *, integer *, integer *), cgebal_(char *, integer *, singlecomplex *, integer *, integer *, integer *, real *, integer *), slabad_(real *, real *); static logical scalea; - extern doublereal clange_(char *, integer *, integer *, complex *, + extern doublereal clange_(char *, integer *, integer *, singlecomplex *, integer *, real *); static real cscale; extern /* Subroutine */ int cgehrd_(integer *, integer *, integer *, - complex *, integer *, complex *, complex *, integer *, integer *), + singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer *), clascl_(char *, integer *, integer *, real *, real *, integer *, - integer *, complex *, integer *, integer *); + integer *, singlecomplex *, integer *, integer *); extern doublereal slamch_(char *); - extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer - *), clacpy_(char *, integer *, integer *, complex *, integer *, - complex *, integer *), xerbla_(char *, integer *); + extern /* Subroutine */ int csscal_(integer *, real *, singlecomplex *, integer + *), clacpy_(char *, integer *, integer *, singlecomplex *, integer *, + singlecomplex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static logical select[1]; static real bignum; extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ int chseqr_(char *, char *, integer *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, - complex *, integer *, integer *), ctrevc_(char *, - char *, logical *, integer *, complex *, integer *, complex *, - integer *, complex *, integer *, integer *, integer *, complex *, + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *, integer *), ctrevc_(char *, + char *, logical *, integer *, singlecomplex *, integer *, singlecomplex *, + integer *, singlecomplex *, integer *, integer *, integer *, singlecomplex *, real *, integer *), cunghr_(integer *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer *); static integer minwrk, maxwrk; static logical wantvl; @@ -1368,7 +1368,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEEV computes for an N-by-N complex nonsymmetric matrix A, the + CGEEV computes for an N-by-N singlecomplex nonsymmetric matrix A, the eigenvalues and, optionally, the left and/or right eigenvectors. The right eigenvector v(j) of A satisfies @@ -1493,7 +1493,7 @@ static real c_b2435 = .5f; (Note: Comments in the code beginning "Workspace:" describe the minimal amount of workspace needed at that point in the code, as well as the preferred amount for good performance. - CWorkspace refers to complex workspace, and RWorkspace to real + CWorkspace refers to singlecomplex workspace, and RWorkspace to real workspace. NB refers to the optimal block size for the immediately following subroutine, as returned by ILAENV. HSWORK refers to the workspace preferred by CHSEQR, as @@ -1816,19 +1816,19 @@ static real c_b2435 = .5f; } /* cgeev_ */ -/* Subroutine */ int cgehd2_(integer *n, integer *ilo, integer *ihi, complex * - a, integer *lda, complex *tau, complex *work, integer *info) +/* Subroutine */ int cgehd2_(integer *n, integer *ilo, integer *ihi, singlecomplex * + a, integer *lda, singlecomplex *tau, singlecomplex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__; - static complex alpha; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * - , integer *, complex *, complex *, integer *, complex *), - clarfg_(integer *, complex *, complex *, integer *, complex *), + static singlecomplex alpha; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * + , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), + clarfg_(integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), xerbla_(char *, integer *); @@ -1842,7 +1842,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEHD2 reduces a complex general matrix A to upper Hessenberg form H + CGEHD2 reduces a singlecomplex general matrix A to upper Hessenberg form H by a unitary similarity transformation: Q' * A * Q = H . Arguments @@ -1892,7 +1892,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on exit in A(i+2:ihi,i), and tau in TAU(i). @@ -1983,34 +1983,34 @@ static real c_b2435 = .5f; } /* cgehd2_ */ -/* Subroutine */ int cgehrd_(integer *n, integer *ilo, integer *ihi, complex * - a, integer *lda, complex *tau, complex *work, integer *lwork, integer +/* Subroutine */ int cgehrd_(integer *n, integer *ilo, integer *ihi, singlecomplex * + a, integer *lda, singlecomplex *tau, singlecomplex *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, j; - static complex t[4160] /* was [65][64] */; + static singlecomplex t[4160] /* was [65][64] */; static integer ib; - static complex ei; + static singlecomplex ei; static integer nb, nh, nx, iws; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, complex *, complex *, integer *, complex *, integer *, - complex *, complex *, integer *); + integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *); static integer nbmin, iinfo; extern /* Subroutine */ int ctrmm_(char *, char *, char *, char *, - integer *, integer *, complex *, complex *, integer *, complex *, + integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *), caxpy_(integer *, - complex *, complex *, integer *, complex *, integer *), cgehd2_( - integer *, integer *, integer *, complex *, integer *, complex *, - complex *, integer *), clahr2_(integer *, integer *, integer *, - complex *, integer *, complex *, complex *, integer *, complex *, + singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *), cgehd2_( + integer *, integer *, integer *, singlecomplex *, integer *, singlecomplex *, + singlecomplex *, integer *), clahr2_(integer *, integer *, integer *, + singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *), clarfb_(char *, char *, char *, char *, integer *, - integer *, integer *, complex *, integer *, complex *, integer *, - complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, + singlecomplex *, integer *, singlecomplex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static integer ldwork, lwkopt; @@ -2027,7 +2027,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEHRD reduces a complex general matrix A to upper Hessenberg form H by + CGEHRD reduces a singlecomplex general matrix A to upper Hessenberg form H by an unitary similarity transformation: Q' * A * Q = H . Arguments @@ -2089,7 +2089,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on exit in A(i+2:ihi,i), and tau in TAU(i). @@ -2313,19 +2313,19 @@ static real c_b2435 = .5f; } /* cgehrd_ */ -/* Subroutine */ int cgelq2_(integer *m, integer *n, complex *a, integer *lda, - complex *tau, complex *work, integer *info) +/* Subroutine */ int cgelq2_(integer *m, integer *n, singlecomplex *a, integer *lda, + singlecomplex *tau, singlecomplex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; /* Local variables */ static integer i__, k; - static complex alpha; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * - , integer *, complex *, complex *, integer *, complex *), - clarfg_(integer *, complex *, complex *, integer *, complex *), - clacgv_(integer *, complex *, integer *), xerbla_(char *, integer + static singlecomplex alpha; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * + , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), + clarfg_(integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), + clacgv_(integer *, singlecomplex *, integer *), xerbla_(char *, integer *); @@ -2339,7 +2339,7 @@ static real c_b2435 = .5f; Purpose ======= - CGELQ2 computes an LQ factorization of a complex m by n matrix A: + CGELQ2 computes an LQ factorization of a singlecomplex m by n matrix A: A = L * Q. Arguments @@ -2383,7 +2383,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in A(i,i+1:n), and tau in TAU(i). @@ -2454,20 +2454,20 @@ static real c_b2435 = .5f; } /* cgelq2_ */ -/* Subroutine */ int cgelqf_(integer *m, integer *n, complex *a, integer *lda, - complex *tau, complex *work, integer *lwork, integer *info) +/* Subroutine */ int cgelqf_(integer *m, integer *n, singlecomplex *a, integer *lda, + singlecomplex *tau, singlecomplex *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; /* Local variables */ static integer i__, k, ib, nb, nx, iws, nbmin, iinfo; - extern /* Subroutine */ int cgelq2_(integer *, integer *, complex *, - integer *, complex *, complex *, integer *), clarfb_(char *, char - *, char *, char *, integer *, integer *, integer *, complex *, - integer *, complex *, integer *, complex *, integer *, complex *, + extern /* Subroutine */ int cgelq2_(integer *, integer *, singlecomplex *, + integer *, singlecomplex *, singlecomplex *, integer *), clarfb_(char *, char + *, char *, char *, integer *, integer *, integer *, singlecomplex *, + integer *, singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, integer *), clarft_(char *, char * - , integer *, integer *, complex *, integer *, complex *, complex * + , integer *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * , integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -2485,7 +2485,7 @@ static real c_b2435 = .5f; Purpose ======= - CGELQF computes an LQ factorization of a complex M-by-N matrix A: + CGELQF computes an LQ factorization of a singlecomplex M-by-N matrix A: A = L * Q. Arguments @@ -2540,7 +2540,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in A(i,i+1:n), and tau in TAU(i). @@ -2685,9 +2685,9 @@ static real c_b2435 = .5f; } /* cgelqf_ */ -/* Subroutine */ int cgelsd_(integer *m, integer *n, integer *nrhs, complex * - a, integer *lda, complex *b, integer *ldb, real *s, real *rcond, - integer *rank, complex *work, integer *lwork, real *rwork, integer * +/* Subroutine */ int cgelsd_(integer *m, integer *n, integer *nrhs, singlecomplex * + a, integer *lda, singlecomplex *b, integer *ldb, real *s, real *rcond, + integer *rank, singlecomplex *work, integer *lwork, real *rwork, integer * iwork, integer *info) { /* System generated locals */ @@ -2699,36 +2699,36 @@ static real c_b2435 = .5f; static integer itau, nlvl, iascl, ibscl; static real sfmin; static integer minmn, maxmn, itaup, itauq, mnthr, nwork; - extern /* Subroutine */ int cgebrd_(integer *, integer *, complex *, - integer *, real *, real *, complex *, complex *, complex *, + extern /* Subroutine */ int cgebrd_(integer *, integer *, singlecomplex *, + integer *, real *, real *, singlecomplex *, singlecomplex *, singlecomplex *, integer *, integer *), slabad_(real *, real *); - extern doublereal clange_(char *, integer *, integer *, complex *, + extern doublereal clange_(char *, integer *, integer *, singlecomplex *, integer *, real *); - extern /* Subroutine */ int cgelqf_(integer *, integer *, complex *, - integer *, complex *, complex *, integer *, integer *), clalsd_( - char *, integer *, integer *, integer *, real *, real *, complex * - , integer *, real *, integer *, complex *, real *, integer *, + extern /* Subroutine */ int cgelqf_(integer *, integer *, singlecomplex *, + integer *, singlecomplex *, singlecomplex *, integer *, integer *), clalsd_( + char *, integer *, integer *, integer *, real *, real *, singlecomplex * + , integer *, real *, integer *, singlecomplex *, real *, integer *, integer *), clascl_(char *, integer *, integer *, real *, - real *, integer *, integer *, complex *, integer *, integer *), cgeqrf_(integer *, integer *, complex *, integer *, - complex *, complex *, integer *, integer *); + real *, integer *, integer *, singlecomplex *, integer *, integer *), cgeqrf_(integer *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *, integer *); extern doublereal slamch_(char *); - extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex - *, integer *, complex *, integer *), claset_(char *, - integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + extern /* Subroutine */ int clacpy_(char *, integer *, integer *, singlecomplex + *, integer *, singlecomplex *, integer *), claset_(char *, + integer *, integer *, singlecomplex *, singlecomplex *, singlecomplex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), cunmbr_(char *, char *, char *, integer *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, - complex *, integer *, integer *), slaset_( + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *, integer *), slaset_( char *, integer *, integer *, real *, real *, real *, integer *), cunmlq_(char *, char *, integer *, integer *, integer *, - complex *, integer *, complex *, complex *, integer *, complex *, + singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, integer *); static integer ldwork; extern /* Subroutine */ int cunmqr_(char *, char *, integer *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, - complex *, integer *, integer *); + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *, integer *); static integer liwork, minwrk, maxwrk; static real smlnum; static integer lrwork; @@ -3416,19 +3416,19 @@ static real c_b2435 = .5f; } /* cgelsd_ */ -/* Subroutine */ int cgeqr2_(integer *m, integer *n, complex *a, integer *lda, - complex *tau, complex *work, integer *info) +/* Subroutine */ int cgeqr2_(integer *m, integer *n, singlecomplex *a, integer *lda, + singlecomplex *tau, singlecomplex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, k; - static complex alpha; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * - , integer *, complex *, complex *, integer *, complex *), - clarfg_(integer *, complex *, complex *, integer *, complex *), + static singlecomplex alpha; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * + , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), + clarfg_(integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), xerbla_(char *, integer *); @@ -3442,7 +3442,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEQR2 computes a QR factorization of a complex m by n matrix A: + CGEQR2 computes a QR factorization of a singlecomplex m by n matrix A: A = Q * R. Arguments @@ -3486,7 +3486,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), and tau in TAU(i). @@ -3554,20 +3554,20 @@ static real c_b2435 = .5f; } /* cgeqr2_ */ -/* Subroutine */ int cgeqrf_(integer *m, integer *n, complex *a, integer *lda, - complex *tau, complex *work, integer *lwork, integer *info) +/* Subroutine */ int cgeqrf_(integer *m, integer *n, singlecomplex *a, integer *lda, + singlecomplex *tau, singlecomplex *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; /* Local variables */ static integer i__, k, ib, nb, nx, iws, nbmin, iinfo; - extern /* Subroutine */ int cgeqr2_(integer *, integer *, complex *, - integer *, complex *, complex *, integer *), clarfb_(char *, char - *, char *, char *, integer *, integer *, integer *, complex *, - integer *, complex *, integer *, complex *, integer *, complex *, + extern /* Subroutine */ int cgeqr2_(integer *, integer *, singlecomplex *, + integer *, singlecomplex *, singlecomplex *, integer *), clarfb_(char *, char + *, char *, char *, integer *, integer *, integer *, singlecomplex *, + integer *, singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, integer *), clarft_(char *, char * - , integer *, integer *, complex *, integer *, complex *, complex * + , integer *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * , integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -3585,7 +3585,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEQRF computes a QR factorization of a complex M-by-N matrix A: + CGEQRF computes a QR factorization of a singlecomplex M-by-N matrix A: A = Q * R. Arguments @@ -3641,7 +3641,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), and tau in TAU(i). @@ -3786,9 +3786,9 @@ static real c_b2435 = .5f; } /* cgeqrf_ */ -/* Subroutine */ int cgesdd_(char *jobz, integer *m, integer *n, complex *a, - integer *lda, real *s, complex *u, integer *ldu, complex *vt, integer - *ldvt, complex *work, integer *lwork, real *rwork, integer *iwork, +/* Subroutine */ int cgesdd_(char *jobz, integer *m, integer *n, singlecomplex *a, + integer *lda, real *s, singlecomplex *u, integer *ldu, singlecomplex *vt, integer + *ldvt, singlecomplex *work, integer *lwork, real *rwork, integer *iwork, integer *info) { /* System generated locals */ @@ -3802,50 +3802,50 @@ static real c_b2435 = .5f; static real anrm; static integer idum[1], ierr, itau, irvt; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, complex *, complex *, integer *, complex *, integer *, - complex *, complex *, integer *); + integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *); extern logical lsame_(char *, char *); static integer chunk, minmn, wrkbl, itaup, itauq; static logical wntqa; static integer nwork; extern /* Subroutine */ int clacp2_(char *, integer *, integer *, real *, - integer *, complex *, integer *); + integer *, singlecomplex *, integer *); static logical wntqn, wntqo, wntqs; static integer mnthr1, mnthr2; - extern /* Subroutine */ int cgebrd_(integer *, integer *, complex *, - integer *, real *, real *, complex *, complex *, complex *, + extern /* Subroutine */ int cgebrd_(integer *, integer *, singlecomplex *, + integer *, real *, real *, singlecomplex *, singlecomplex *, singlecomplex *, integer *, integer *); - extern doublereal clange_(char *, integer *, integer *, complex *, + extern doublereal clange_(char *, integer *, integer *, singlecomplex *, integer *, real *); - extern /* Subroutine */ int cgelqf_(integer *, integer *, complex *, - integer *, complex *, complex *, integer *, integer *), clacrm_( - integer *, integer *, complex *, integer *, real *, integer *, - complex *, integer *, real *), clarcm_(integer *, integer *, real - *, integer *, complex *, integer *, complex *, integer *, real *), + extern /* Subroutine */ int cgelqf_(integer *, integer *, singlecomplex *, + integer *, singlecomplex *, singlecomplex *, integer *, integer *), clacrm_( + integer *, integer *, singlecomplex *, integer *, real *, integer *, + singlecomplex *, integer *, real *), clarcm_(integer *, integer *, real + *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, real *), clascl_(char *, integer *, integer *, real *, real *, integer *, - integer *, complex *, integer *, integer *), sbdsdc_(char + integer *, singlecomplex *, integer *, integer *), sbdsdc_(char *, char *, integer *, real *, real *, real *, integer *, real *, - integer *, real *, integer *, real *, integer *, integer *), cgeqrf_(integer *, integer *, complex *, integer - *, complex *, complex *, integer *, integer *); + integer *, real *, integer *, real *, integer *, integer *), cgeqrf_(integer *, integer *, singlecomplex *, integer + *, singlecomplex *, singlecomplex *, integer *, integer *); extern doublereal slamch_(char *); - extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex - *, integer *, complex *, integer *), claset_(char *, - integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); + extern /* Subroutine */ int clacpy_(char *, integer *, integer *, singlecomplex + *, integer *, singlecomplex *, integer *), claset_(char *, + integer *, integer *, singlecomplex *, singlecomplex *, singlecomplex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int cungbr_(char *, integer *, integer *, integer - *, complex *, integer *, complex *, complex *, integer *, integer + *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer *); static real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), cunmbr_(char *, char *, char *, integer *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, - complex *, integer *, integer *), cunglq_( - integer *, integer *, integer *, complex *, integer *, complex *, - complex *, integer *, integer *); + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *, integer *), cunglq_( + integer *, integer *, integer *, singlecomplex *, integer *, singlecomplex *, + singlecomplex *, integer *, integer *); static integer ldwrkl; extern /* Subroutine */ int cungqr_(integer *, integer *, integer *, - complex *, integer *, complex *, complex *, integer *, integer *); + singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer *); static integer ldwrkr, minwrk, ldwrku, maxwrk, ldwkvt; static real smlnum; static logical wntqas; @@ -3863,7 +3863,7 @@ static real c_b2435 = .5f; Purpose ======= - CGESDD computes the singular value decomposition (SVD) of a complex + CGESDD computes the singular value decomposition (SVD) of a singlecomplex M-by-N matrix A, optionally computing the left and/or right singular vectors, by using divide-and-conquer method. The SVD is written @@ -4041,7 +4041,7 @@ static real c_b2435 = .5f; (Note: Comments in the code beginning "Workspace:" describe the minimal amount of workspace needed at that point in the code, as well as the preferred amount for good performance. - CWorkspace refers to complex workspace, and RWorkspace to + CWorkspace refers to singlecomplex workspace, and RWorkspace to real workspace. NB refers to the optimal block size for the immediately following subroutine, as returned by ILAENV.) */ @@ -4050,7 +4050,7 @@ static real c_b2435 = .5f; if (*m >= *n) { /* - There is no complex work space needed for bidiagonal SVD + There is no singlecomplex work space needed for bidiagonal SVD The real work space needed for bidiagonal SVD is BDSPAC for computing singular values and singular vectors; BDSPAN for computing singular values only. @@ -4243,7 +4243,7 @@ static real c_b2435 = .5f; } else { /* - There is no complex work space needed for bidiagonal SVD + There is no singlecomplex work space needed for bidiagonal SVD The real work space needed for bidiagonal SVD is BDSPAC for computing singular values and singular vectors; BDSPAN for computing singular values only. @@ -4621,7 +4621,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to complex matrix WORK(IU) + Copy real matrix RWORK(IRU) to singlecomplex matrix WORK(IU) Overwrite WORK(IU) by the left singular vectors of R (CWorkspace: need 2*N*N+3*N, prefer M*N+N*N+2*N+N*NB) (RWorkspace: 0) @@ -4634,7 +4634,7 @@ static real c_b2435 = .5f; ierr); /* - Copy real matrix RWORK(IRVT) to complex matrix VT + Copy real matrix RWORK(IRVT) to singlecomplex matrix VT Overwrite VT by the right singular vectors of R (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) (RWorkspace: 0) @@ -4742,7 +4742,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to complex matrix U + Copy real matrix RWORK(IRU) to singlecomplex matrix U Overwrite U by left singular vectors of R (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) (RWorkspace: 0) @@ -4754,7 +4754,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr); /* - Copy real matrix RWORK(IRVT) to complex matrix VT + Copy real matrix RWORK(IRVT) to singlecomplex matrix VT Overwrite VT by right singular vectors of R (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) (RWorkspace: 0) @@ -4851,7 +4851,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to complex matrix WORK(IU) + Copy real matrix RWORK(IRU) to singlecomplex matrix WORK(IU) Overwrite WORK(IU) by left singular vectors of R (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) (RWorkspace: 0) @@ -4864,7 +4864,7 @@ static real c_b2435 = .5f; ierr); /* - Copy real matrix RWORK(IRVT) to complex matrix VT + Copy real matrix RWORK(IRVT) to singlecomplex matrix VT Overwrite VT by right singular vectors of R (CWorkspace: need 3*N, prefer 2*N+N*NB) (RWorkspace: 0) @@ -5202,7 +5202,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRVT) to complex matrix VT + Copy real matrix RWORK(IRVT) to singlecomplex matrix VT Overwrite VT by right singular vectors of A (Cworkspace: need 2*N, prefer N+N*NB) (Rworkspace: need 0) @@ -5217,7 +5217,7 @@ static real c_b2435 = .5f; if (*lwork >= *m * *n + *n * 3) { /* - Copy real matrix RWORK(IRU) to complex matrix WORK(IU) + Copy real matrix RWORK(IRU) to singlecomplex matrix WORK(IU) Overwrite WORK(IU) by left singular vectors of A, copying to A (Cworkspace: need M*N+2*N, prefer M*N+N+N*NB) @@ -5284,7 +5284,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to complex matrix U + Copy real matrix RWORK(IRU) to singlecomplex matrix U Overwrite U by left singular vectors of A (CWorkspace: need 3*N, prefer 2*N+N*NB) (RWorkspace: 0) @@ -5297,7 +5297,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr); /* - Copy real matrix RWORK(IRVT) to complex matrix VT + Copy real matrix RWORK(IRVT) to singlecomplex matrix VT Overwrite VT by right singular vectors of A (CWorkspace: need 3*N, prefer 2*N+N*NB) (RWorkspace: 0) @@ -5336,7 +5336,7 @@ static real c_b2435 = .5f; } /* - Copy real matrix RWORK(IRU) to complex matrix U + Copy real matrix RWORK(IRU) to singlecomplex matrix U Overwrite U by left singular vectors of A (CWorkspace: need 2*N+M, prefer 2*N+M*NB) (RWorkspace: 0) @@ -5348,7 +5348,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr); /* - Copy real matrix RWORK(IRVT) to complex matrix VT + Copy real matrix RWORK(IRVT) to singlecomplex matrix VT Overwrite VT by right singular vectors of A (CWorkspace: need 3*N, prefer 2*N+N*NB) (RWorkspace: 0) @@ -5512,7 +5512,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to complex matrix WORK(IU) + Copy real matrix RWORK(IRU) to singlecomplex matrix WORK(IU) Overwrite WORK(IU) by the left singular vectors of L (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) (RWorkspace: 0) @@ -5524,7 +5524,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr); /* - Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) + Copy real matrix RWORK(IRVT) to singlecomplex matrix WORK(IVT) Overwrite WORK(IVT) by the right singular vectors of L (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) (RWorkspace: 0) @@ -5632,7 +5632,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to complex matrix U + Copy real matrix RWORK(IRU) to singlecomplex matrix U Overwrite U by left singular vectors of L (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) (RWorkspace: 0) @@ -5644,7 +5644,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr); /* - Copy real matrix RWORK(IRVT) to complex matrix VT + Copy real matrix RWORK(IRVT) to singlecomplex matrix VT Overwrite VT by left singular vectors of L (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) (RWorkspace: 0) @@ -5741,7 +5741,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to complex matrix U + Copy real matrix RWORK(IRU) to singlecomplex matrix U Overwrite U by left singular vectors of L (CWorkspace: need 3*M, prefer 2*M+M*NB) (RWorkspace: 0) @@ -5753,7 +5753,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr); /* - Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) + Copy real matrix RWORK(IRVT) to singlecomplex matrix WORK(IVT) Overwrite WORK(IVT) by right singular vectors of L (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) (RWorkspace: 0) @@ -6095,7 +6095,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to complex matrix U + Copy real matrix RWORK(IRU) to singlecomplex matrix U Overwrite U by left singular vectors of A (Cworkspace: need 2*M, prefer M+M*NB) (Rworkspace: need 0) @@ -6109,7 +6109,7 @@ static real c_b2435 = .5f; if (*lwork >= *m * *n + *m * 3) { /* - Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) + Copy real matrix RWORK(IRVT) to singlecomplex matrix WORK(IVT) Overwrite WORK(IVT) by right singular vectors of A, copying to A (Cworkspace: need M*N+2*M, prefer M*N+M+M*NB) @@ -6174,7 +6174,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to complex matrix U + Copy real matrix RWORK(IRU) to singlecomplex matrix U Overwrite U by left singular vectors of A (CWorkspace: need 3*M, prefer 2*M+M*NB) (RWorkspace: M*M) @@ -6186,7 +6186,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr); /* - Copy real matrix RWORK(IRVT) to complex matrix VT + Copy real matrix RWORK(IRVT) to singlecomplex matrix VT Overwrite VT by right singular vectors of A (CWorkspace: need 3*M, prefer 2*M+M*NB) (RWorkspace: M*M) @@ -6217,7 +6217,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to complex matrix U + Copy real matrix RWORK(IRU) to singlecomplex matrix U Overwrite U by left singular vectors of A (CWorkspace: need 3*M, prefer 2*M+M*NB) (RWorkspace: M*M) @@ -6233,7 +6233,7 @@ static real c_b2435 = .5f; claset_("F", n, n, &c_b56, &c_b57, &vt[vt_offset], ldvt); /* - Copy real matrix RWORK(IRVT) to complex matrix VT + Copy real matrix RWORK(IRVT) to singlecomplex matrix VT Overwrite VT by right singular vectors of A (CWorkspace: need 2*M+N, prefer 2*M+N*NB) (RWorkspace: M*M) @@ -6283,16 +6283,16 @@ static real c_b2435 = .5f; } /* cgesdd_ */ -/* Subroutine */ int cgesv_(integer *n, integer *nrhs, complex *a, integer * - lda, integer *ipiv, complex *b, integer *ldb, integer *info) +/* Subroutine */ int cgesv_(integer *n, integer *nrhs, singlecomplex *a, integer * + lda, integer *ipiv, singlecomplex *b, integer *ldb, integer *info) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ - extern /* Subroutine */ int cgetrf_(integer *, integer *, complex *, - integer *, integer *, integer *), xerbla_(char *, integer *), cgetrs_(char *, integer *, integer *, complex *, integer - *, integer *, complex *, integer *, integer *); + extern /* Subroutine */ int cgetrf_(integer *, integer *, singlecomplex *, + integer *, integer *, integer *), xerbla_(char *, integer *), cgetrs_(char *, integer *, integer *, singlecomplex *, integer + *, integer *, singlecomplex *, integer *, integer *); /* @@ -6305,7 +6305,7 @@ static real c_b2435 = .5f; Purpose ======= - CGESV computes the solution to a complex system of linear equations + CGESV computes the solution to a singlecomplex system of linear equations A * X = B, where A is an N-by-N matrix and X and B are N-by-NRHS matrices. @@ -6401,22 +6401,22 @@ static real c_b2435 = .5f; } /* cgesv_ */ -/* Subroutine */ int cgetf2_(integer *m, integer *n, complex *a, integer *lda, +/* Subroutine */ int cgetf2_(integer *m, integer *n, singlecomplex *a, integer *lda, integer *ipiv, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, j, jp; - extern /* Subroutine */ int cscal_(integer *, complex *, complex *, - integer *), cgeru_(integer *, integer *, complex *, complex *, - integer *, complex *, integer *, complex *, integer *); + extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, + integer *), cgeru_(integer *, integer *, singlecomplex *, singlecomplex *, + integer *, singlecomplex *, integer *, singlecomplex *, integer *); static real sfmin; - extern /* Subroutine */ int cswap_(integer *, complex *, integer *, - complex *, integer *); - extern integer icamax_(integer *, complex *, integer *); + extern /* Subroutine */ int cswap_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *); + extern integer icamax_(integer *, singlecomplex *, integer *); extern doublereal slamch_(char *); extern /* Subroutine */ int xerbla_(char *, integer *); @@ -6568,27 +6568,27 @@ static real c_b2435 = .5f; } /* cgetf2_ */ -/* Subroutine */ int cgetrf_(integer *m, integer *n, complex *a, integer *lda, +/* Subroutine */ int cgetrf_(integer *m, integer *n, singlecomplex *a, integer *lda, integer *ipiv, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, j, jb, nb; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, complex *, complex *, integer *, complex *, integer *, - complex *, complex *, integer *); + integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *); static integer iinfo; extern /* Subroutine */ int ctrsm_(char *, char *, char *, char *, - integer *, integer *, complex *, complex *, integer *, complex *, + integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *), cgetf2_(integer *, - integer *, complex *, integer *, integer *, integer *), xerbla_( + integer *, singlecomplex *, integer *, integer *, integer *), xerbla_( char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); - extern /* Subroutine */ int claswp_(integer *, complex *, integer *, + extern /* Subroutine */ int claswp_(integer *, singlecomplex *, integer *, integer *, integer *, integer *, integer *); @@ -6759,8 +6759,8 @@ static real c_b2435 = .5f; } /* cgetrf_ */ -/* Subroutine */ int cgetrs_(char *trans, integer *n, integer *nrhs, complex * - a, integer *lda, integer *ipiv, complex *b, integer *ldb, integer * +/* Subroutine */ int cgetrs_(char *trans, integer *n, integer *nrhs, singlecomplex * + a, integer *lda, integer *ipiv, singlecomplex *b, integer *ldb, integer * info) { /* System generated locals */ @@ -6769,9 +6769,9 @@ static real c_b2435 = .5f; /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ int ctrsm_(char *, char *, char *, char *, - integer *, integer *, complex *, complex *, integer *, complex *, + integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *), xerbla_(char *, - integer *), claswp_(integer *, complex *, integer *, + integer *), claswp_(integer *, singlecomplex *, integer *, integer *, integer *, integer *, integer *); static logical notran; @@ -6917,8 +6917,8 @@ static real c_b2435 = .5f; } /* cgetrs_ */ -/* Subroutine */ int cheevd_(char *jobz, char *uplo, integer *n, complex *a, - integer *lda, real *w, complex *work, integer *lwork, real *rwork, +/* Subroutine */ int cheevd_(char *jobz, char *uplo, integer *n, singlecomplex *a, + integer *lda, real *w, singlecomplex *work, integer *lwork, real *rwork, integer *lrwork, integer *iwork, integer *liwork, integer *info) { /* System generated locals */ @@ -6941,17 +6941,17 @@ static real c_b2435 = .5f; static integer llrwk, lropt; static logical wantz; static integer indwk2, llwrk2; - extern doublereal clanhe_(char *, char *, integer *, complex *, integer *, + extern doublereal clanhe_(char *, char *, integer *, singlecomplex *, integer *, real *); static integer iscale; extern /* Subroutine */ int clascl_(char *, integer *, integer *, real *, - real *, integer *, integer *, complex *, integer *, integer *), cstedc_(char *, integer *, real *, real *, complex *, - integer *, complex *, integer *, real *, integer *, integer *, + real *, integer *, integer *, singlecomplex *, integer *, integer *), cstedc_(char *, integer *, real *, real *, singlecomplex *, + integer *, singlecomplex *, integer *, real *, integer *, integer *, integer *, integer *); extern doublereal slamch_(char *); - extern /* Subroutine */ int chetrd_(char *, integer *, complex *, integer - *, real *, real *, complex *, complex *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer - *, complex *, integer *); + extern /* Subroutine */ int chetrd_(char *, integer *, singlecomplex *, integer + *, real *, real *, singlecomplex *, singlecomplex *, integer *, integer *), clacpy_(char *, integer *, integer *, singlecomplex *, integer + *, singlecomplex *, integer *); static real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -6961,8 +6961,8 @@ static real c_b2435 = .5f; extern /* Subroutine */ int ssterf_(integer *, real *, real *, integer *); static integer lrwmin; extern /* Subroutine */ int cunmtr_(char *, char *, char *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, - complex *, integer *, integer *); + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *, integer *); static integer llwork; static real smlnum; static logical lquery; @@ -6979,7 +6979,7 @@ static real c_b2435 = .5f; ======= CHEEVD computes all eigenvalues and, optionally, eigenvectors of a - complex Hermitian matrix A. If eigenvectors are desired, it uses a + singlecomplex Hermitian matrix A. If eigenvectors are desired, it uses a divide and conquer algorithm. The divide and conquer algorithm makes very mild assumptions about @@ -7260,30 +7260,30 @@ static real c_b2435 = .5f; } /* cheevd_ */ -/* Subroutine */ int chetd2_(char *uplo, integer *n, complex *a, integer *lda, - real *d__, real *e, complex *tau, integer *info) +/* Subroutine */ int chetd2_(char *uplo, integer *n, singlecomplex *a, integer *lda, + real *d__, real *e, singlecomplex *tau, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; real r__1; - complex q__1, q__2, q__3, q__4; + singlecomplex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__; - static complex taui; - extern /* Subroutine */ int cher2_(char *, integer *, complex *, complex * - , integer *, complex *, integer *, complex *, integer *); - static complex alpha; - extern /* Complex */ VOID cdotc_(complex *, integer *, complex *, integer - *, complex *, integer *); + static singlecomplex taui; + extern /* Subroutine */ int cher2_(char *, integer *, singlecomplex *, singlecomplex * + , integer *, singlecomplex *, integer *, singlecomplex *, integer *); + static singlecomplex alpha; + extern /* Complex */ VOID cdotc_(singlecomplex *, integer *, singlecomplex *, integer + *, singlecomplex *, integer *); extern logical lsame_(char *, char *); - extern /* Subroutine */ int chemv_(char *, integer *, complex *, complex * - , integer *, complex *, integer *, complex *, complex *, integer * - ), caxpy_(integer *, complex *, complex *, integer *, - complex *, integer *); + extern /* Subroutine */ int chemv_(char *, integer *, singlecomplex *, singlecomplex * + , integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer * + ), caxpy_(integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *); static logical upper; - extern /* Subroutine */ int clarfg_(integer *, complex *, complex *, - integer *, complex *), xerbla_(char *, integer *); + extern /* Subroutine */ int clarfg_(integer *, singlecomplex *, singlecomplex *, + integer *, singlecomplex *), xerbla_(char *, integer *); /* @@ -7296,7 +7296,7 @@ static real c_b2435 = .5f; Purpose ======= - CHETD2 reduces a complex Hermitian matrix A to real symmetric + CHETD2 reduces a singlecomplex Hermitian matrix A to real symmetric tridiagonal form T by a unitary similarity transformation: Q' * A * Q = T. @@ -7362,7 +7362,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in A(1:i-1,i+1), and tau in TAU(i). @@ -7375,7 +7375,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i), and tau in TAU(i). @@ -7596,24 +7596,24 @@ static real c_b2435 = .5f; } /* chetd2_ */ -/* Subroutine */ int chetrd_(char *uplo, integer *n, complex *a, integer *lda, - real *d__, real *e, complex *tau, complex *work, integer *lwork, +/* Subroutine */ int chetrd_(char *uplo, integer *n, singlecomplex *a, integer *lda, + real *d__, real *e, singlecomplex *tau, singlecomplex *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, j, nb, kk, nx, iws; extern logical lsame_(char *, char *); static integer nbmin, iinfo; static logical upper; - extern /* Subroutine */ int chetd2_(char *, integer *, complex *, integer - *, real *, real *, complex *, integer *), cher2k_(char *, - char *, integer *, integer *, complex *, complex *, integer *, - complex *, integer *, real *, complex *, integer *), clatrd_(char *, integer *, integer *, complex *, integer - *, real *, complex *, complex *, integer *), xerbla_(char + extern /* Subroutine */ int chetd2_(char *, integer *, singlecomplex *, integer + *, real *, real *, singlecomplex *, integer *), cher2k_(char *, + char *, integer *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *, real *, singlecomplex *, integer *), clatrd_(char *, integer *, integer *, singlecomplex *, integer + *, real *, singlecomplex *, singlecomplex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -7631,7 +7631,7 @@ static real c_b2435 = .5f; Purpose ======= - CHETRD reduces a complex Hermitian matrix A to real symmetric + CHETRD reduces a singlecomplex Hermitian matrix A to real symmetric tridiagonal form T by a unitary similarity transformation: Q**H * A * Q = T. @@ -7708,7 +7708,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in A(1:i-1,i+1), and tau in TAU(i). @@ -7721,7 +7721,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i), and tau in TAU(i). @@ -7952,33 +7952,33 @@ static real c_b2435 = .5f; } /* chetrd_ */ /* Subroutine */ int chseqr_(char *job, char *compz, integer *n, integer *ilo, - integer *ihi, complex *h__, integer *ldh, complex *w, complex *z__, - integer *ldz, complex *work, integer *lwork, integer *info) + integer *ihi, singlecomplex *h__, integer *ldh, singlecomplex *w, singlecomplex *z__, + integer *ldz, singlecomplex *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3[2]; real r__1, r__2, r__3; - complex q__1; + singlecomplex q__1; char ch__1[2]; /* Local variables */ - static complex hl[2401] /* was [49][49] */; + static singlecomplex hl[2401] /* was [49][49] */; static integer kbot, nmin; extern logical lsame_(char *, char *); - extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, - complex *, integer *); + extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *); static logical initz; - static complex workl[49]; + static singlecomplex workl[49]; static logical wantt, wantz; extern /* Subroutine */ int claqr0_(logical *, logical *, integer *, - integer *, integer *, complex *, integer *, complex *, integer *, - integer *, complex *, integer *, complex *, integer *, integer *), + integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, + integer *, singlecomplex *, integer *, singlecomplex *, integer *, integer *), clahqr_(logical *, logical *, integer *, integer *, integer *, - complex *, integer *, complex *, integer *, integer *, complex *, + singlecomplex *, integer *, singlecomplex *, integer *, integer *, singlecomplex *, integer *, integer *), clacpy_(char *, integer *, integer *, - complex *, integer *, complex *, integer *), claset_(char - *, integer *, integer *, complex *, complex *, complex *, integer + singlecomplex *, integer *, singlecomplex *, integer *), claset_(char + *, integer *, integer *, singlecomplex *, singlecomplex *, singlecomplex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -8404,23 +8404,23 @@ static real c_b2435 = .5f; return 0; } /* chseqr_ */ -/* Subroutine */ int clabrd_(integer *m, integer *n, integer *nb, complex *a, - integer *lda, real *d__, real *e, complex *tauq, complex *taup, - complex *x, integer *ldx, complex *y, integer *ldy) +/* Subroutine */ int clabrd_(integer *m, integer *n, integer *nb, singlecomplex *a, + integer *lda, real *d__, real *e, singlecomplex *tauq, singlecomplex *taup, + singlecomplex *x, integer *ldx, singlecomplex *y, integer *ldy) { /* System generated locals */ integer a_dim1, a_offset, x_dim1, x_offset, y_dim1, y_offset, i__1, i__2, i__3; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__; - static complex alpha; - extern /* Subroutine */ int cscal_(integer *, complex *, complex *, - integer *), cgemv_(char *, integer *, integer *, complex *, - complex *, integer *, complex *, integer *, complex *, complex *, - integer *), clarfg_(integer *, complex *, complex *, - integer *, complex *), clacgv_(integer *, complex *, integer *); + static singlecomplex alpha; + extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, + integer *), cgemv_(char *, integer *, integer *, singlecomplex *, + singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, + integer *), clarfg_(integer *, singlecomplex *, singlecomplex *, + integer *, singlecomplex *), clacgv_(integer *, singlecomplex *, integer *); /* @@ -8433,7 +8433,7 @@ static real c_b2435 = .5f; Purpose ======= - CLABRD reduces the first NB rows and columns of a complex general + CLABRD reduces the first NB rows and columns of a singlecomplex general m by n matrix A to upper or lower real bidiagonal form by a unitary transformation Q' * A * P, and returns the matrices X and Y which are needed to apply the transformation to the unreduced part of A. @@ -8518,7 +8518,7 @@ static real c_b2435 = .5f; H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' - where tauq and taup are complex scalars, and v and u are complex + where tauq and taup are singlecomplex scalars, and v and u are singlecomplex vectors. If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in @@ -8875,11 +8875,11 @@ static real c_b2435 = .5f; } /* clabrd_ */ -/* Subroutine */ int clacgv_(integer *n, complex *x, integer *incx) +/* Subroutine */ int clacgv_(integer *n, singlecomplex *x, integer *incx) { /* System generated locals */ integer i__1, i__2; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, ioff; @@ -8895,7 +8895,7 @@ static real c_b2435 = .5f; Purpose ======= - CLACGV conjugates a complex vector of length N. + CLACGV conjugates a singlecomplex vector of length N. Arguments ========= @@ -8948,7 +8948,7 @@ static real c_b2435 = .5f; } /* clacgv_ */ /* Subroutine */ int clacp2_(char *uplo, integer *m, integer *n, real *a, - integer *lda, complex *b, integer *ldb) + integer *lda, singlecomplex *b, integer *ldb) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4; @@ -8969,7 +8969,7 @@ static real c_b2435 = .5f; ======= CLACP2 copies all or part of a real two-dimensional matrix A to a - complex matrix B. + singlecomplex matrix B. Arguments ========= @@ -9059,8 +9059,8 @@ static real c_b2435 = .5f; } /* clacp2_ */ -/* Subroutine */ int clacpy_(char *uplo, integer *m, integer *n, complex *a, - integer *lda, complex *b, integer *ldb) +/* Subroutine */ int clacpy_(char *uplo, integer *m, integer *n, singlecomplex *a, + integer *lda, singlecomplex *b, integer *ldb) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4; @@ -9171,14 +9171,14 @@ static real c_b2435 = .5f; } /* clacpy_ */ -/* Subroutine */ int clacrm_(integer *m, integer *n, complex *a, integer *lda, - real *b, integer *ldb, complex *c__, integer *ldc, real *rwork) +/* Subroutine */ int clacrm_(integer *m, integer *n, singlecomplex *a, integer *lda, + real *b, integer *ldb, singlecomplex *c__, integer *ldc, real *rwork) { /* System generated locals */ integer b_dim1, b_offset, a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5; real r__1; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, j, l; @@ -9199,8 +9199,8 @@ static real c_b2435 = .5f; CLACRM performs a very simple matrix-matrix multiplication: C := A * B, - where A is M by N and complex; B is N by N and real; - C is M by N and complex. + where A is M by N and singlecomplex; B is N by N and real; + C is M by N and singlecomplex. Arguments ========= @@ -9315,11 +9315,11 @@ static real c_b2435 = .5f; } /* clacrm_ */ -/* Complex */ VOID cladiv_(complex * ret_val, complex *x, complex *y) +/* Complex */ VOID cladiv_(singlecomplex * ret_val, singlecomplex *x, singlecomplex *y) { /* System generated locals */ real r__1, r__2, r__3, r__4; - complex q__1; + singlecomplex q__1; /* Local variables */ static real zi, zr; @@ -9337,7 +9337,7 @@ static real c_b2435 = .5f; Purpose ======= - CLADIV := X / Y, where X and Y are complex. The computation of X / Y + CLADIV := X / Y, where X and Y are singlecomplex. The computation of X / Y will not overflow on an intermediary step unless the results overflows. @@ -9346,7 +9346,7 @@ static real c_b2435 = .5f; X (input) COMPLEX Y (input) COMPLEX - The complex scalars X and Y. + The singlecomplex scalars X and Y. ===================================================================== */ @@ -9367,7 +9367,7 @@ static real c_b2435 = .5f; } /* cladiv_ */ /* Subroutine */ int claed0_(integer *qsiz, integer *n, real *d__, real *e, - complex *q, integer *ldq, complex *qstore, integer *ldqs, real *rwork, + singlecomplex *q, integer *ldq, singlecomplex *qstore, integer *ldqs, real *rwork, integer *iwork, integer *info) { /* System generated locals */ @@ -9378,20 +9378,20 @@ static real c_b2435 = .5f; static integer i__, j, k, ll, iq, lgn, msd2, smm1, spm1, spm2; static real temp; static integer curr, iperm; - extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, - complex *, integer *); + extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *); static integer indxq, iwrem; extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *, integer *); static integer iqptr; extern /* Subroutine */ int claed7_(integer *, integer *, integer *, - integer *, integer *, integer *, real *, complex *, integer *, + integer *, integer *, integer *, real *, singlecomplex *, integer *, real *, integer *, real *, integer *, integer *, integer *, - integer *, integer *, real *, complex *, real *, integer *, + integer *, integer *, real *, singlecomplex *, real *, integer *, integer *); static integer tlvls; - extern /* Subroutine */ int clacrm_(integer *, integer *, complex *, - integer *, real *, integer *, complex *, integer *, real *); + extern /* Subroutine */ int clacrm_(integer *, integer *, singlecomplex *, + integer *, real *, integer *, singlecomplex *, integer *, real *); static integer igivcl; extern /* Subroutine */ int xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, @@ -9714,10 +9714,10 @@ static real c_b2435 = .5f; } /* claed0_ */ /* Subroutine */ int claed7_(integer *n, integer *cutpnt, integer *qsiz, - integer *tlvls, integer *curlvl, integer *curpbm, real *d__, complex * + integer *tlvls, integer *curlvl, integer *curpbm, real *d__, singlecomplex * q, integer *ldq, real *rho, integer *indxq, real *qstore, integer * qptr, integer *prmptr, integer *perm, integer *givptr, integer * - givcol, real *givnum, complex *work, real *rwork, integer *iwork, + givcol, real *givnum, singlecomplex *work, real *rwork, integer *iwork, integer *info) { /* System generated locals */ @@ -9726,8 +9726,8 @@ static real c_b2435 = .5f; /* Local variables */ static integer i__, k, n1, n2, iq, iw, iz, ptr, indx, curr, indxc, indxp; extern /* Subroutine */ int claed8_(integer *, integer *, integer *, - complex *, integer *, real *, real *, integer *, real *, real *, - complex *, integer *, real *, integer *, integer *, integer *, + singlecomplex *, integer *, real *, real *, integer *, real *, real *, + singlecomplex *, integer *, real *, integer *, integer *, integer *, integer *, integer *, integer *, real *, integer *), slaed9_( integer *, integer *, integer *, integer *, real *, real *, integer *, real *, real *, real *, real *, integer *, integer *), @@ -9735,8 +9735,8 @@ static real c_b2435 = .5f; integer *, integer *, integer *, real *, real *, integer *, real * , real *, integer *); static integer idlmda; - extern /* Subroutine */ int clacrm_(integer *, integer *, complex *, - integer *, real *, integer *, complex *, integer *, real *), + extern /* Subroutine */ int clacrm_(integer *, integer *, singlecomplex *, + integer *, real *, integer *, singlecomplex *, integer *, real *), xerbla_(char *, integer *), slamrg_(integer *, integer *, real *, integer *, integer *, integer *); static integer coltyp; @@ -10015,9 +10015,9 @@ static real c_b2435 = .5f; } /* claed7_ */ -/* Subroutine */ int claed8_(integer *k, integer *n, integer *qsiz, complex * +/* Subroutine */ int claed8_(integer *k, integer *n, integer *qsiz, singlecomplex * q, integer *ldq, real *d__, real *rho, integer *cutpnt, real *z__, - real *dlamda, complex *q2, integer *ldq2, real *w, integer *indxp, + real *dlamda, singlecomplex *q2, integer *ldq2, real *w, integer *indxp, integer *indx, integer *indxq, integer *perm, integer *givptr, integer *givcol, real *givnum, integer *info) { @@ -10033,13 +10033,13 @@ static real c_b2435 = .5f; static real eps, tau, tol; static integer jlam, imax, jmax; extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *), - ccopy_(integer *, complex *, integer *, complex *, integer *), - csrot_(integer *, complex *, integer *, complex *, integer *, + ccopy_(integer *, singlecomplex *, integer *, singlecomplex *, integer *), + csrot_(integer *, singlecomplex *, integer *, singlecomplex *, integer *, real *, real *), scopy_(integer *, real *, integer *, real *, integer *); extern doublereal slapy2_(real *, real *), slamch_(char *); - extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex - *, integer *, complex *, integer *), xerbla_(char *, + extern /* Subroutine */ int clacpy_(char *, integer *, integer *, singlecomplex + *, integer *, singlecomplex *, integer *), xerbla_(char *, integer *); extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ int slamrg_(integer *, integer *, real *, integer @@ -10436,43 +10436,43 @@ static real c_b2435 = .5f; } /* claed8_ */ /* Subroutine */ int clahqr_(logical *wantt, logical *wantz, integer *n, - integer *ilo, integer *ihi, complex *h__, integer *ldh, complex *w, - integer *iloz, integer *ihiz, complex *z__, integer *ldz, integer * + integer *ilo, integer *ihi, singlecomplex *h__, integer *ldh, singlecomplex *w, + integer *iloz, integer *ihiz, singlecomplex *z__, integer *ldz, integer * info) { /* System generated locals */ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4; real r__1, r__2, r__3, r__4, r__5, r__6; - complex q__1, q__2, q__3, q__4, q__5, q__6, q__7; + singlecomplex q__1, q__2, q__3, q__4, q__5, q__6, q__7; /* Local variables */ static integer i__, j, k, l, m; static real s; - static complex t, u, v[2], x, y; + static singlecomplex t, u, v[2], x, y; static integer i1, i2; - static complex t1; + static singlecomplex t1; static real t2; - static complex v2; + static singlecomplex v2; static real aa, ab, ba, bb, h10; - static complex h11; + static singlecomplex h11; static real h21; - static complex h22, sc; + static singlecomplex h22, sc; static integer nh, nz; static real sx; static integer jhi; - static complex h11s; + static singlecomplex h11s; static integer jlo, its; static real ulp; - static complex sum; + static singlecomplex sum; static real tst; - static complex temp; - extern /* Subroutine */ int cscal_(integer *, complex *, complex *, - integer *), ccopy_(integer *, complex *, integer *, complex *, + static singlecomplex temp; + extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, + integer *), ccopy_(integer *, singlecomplex *, integer *, singlecomplex *, integer *); static real rtemp; extern /* Subroutine */ int slabad_(real *, real *), clarfg_(integer *, - complex *, complex *, integer *, complex *); - extern /* Complex */ VOID cladiv_(complex *, complex *, complex *); + singlecomplex *, singlecomplex *, integer *, singlecomplex *); + extern /* Complex */ VOID cladiv_(singlecomplex *, singlecomplex *, singlecomplex *); extern doublereal slamch_(char *); static real safmin, safmax, smlnum; @@ -11166,33 +11166,33 @@ static real c_b2435 = .5f; } /* clahqr_ */ -/* Subroutine */ int clahr2_(integer *n, integer *k, integer *nb, complex *a, - integer *lda, complex *tau, complex *t, integer *ldt, complex *y, +/* Subroutine */ int clahr2_(integer *n, integer *k, integer *nb, singlecomplex *a, + integer *lda, singlecomplex *tau, singlecomplex *t, integer *ldt, singlecomplex *y, integer *ldy) { /* System generated locals */ integer a_dim1, a_offset, t_dim1, t_offset, y_dim1, y_offset, i__1, i__2, i__3; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__; - static complex ei; - extern /* Subroutine */ int cscal_(integer *, complex *, complex *, + static singlecomplex ei; + extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, integer *), cgemm_(char *, char *, integer *, integer *, integer * - , complex *, complex *, integer *, complex *, integer *, complex * - , complex *, integer *), cgemv_(char *, integer *, - integer *, complex *, complex *, integer *, complex *, integer *, - complex *, complex *, integer *), ccopy_(integer *, - complex *, integer *, complex *, integer *), ctrmm_(char *, char * - , char *, char *, integer *, integer *, complex *, complex *, - integer *, complex *, integer *), - caxpy_(integer *, complex *, complex *, integer *, complex *, - integer *), ctrmv_(char *, char *, char *, integer *, complex *, - integer *, complex *, integer *), clarfg_( - integer *, complex *, complex *, integer *, complex *), clacgv_( - integer *, complex *, integer *), clacpy_(char *, integer *, - integer *, complex *, integer *, complex *, integer *); + , singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex * + , singlecomplex *, integer *), cgemv_(char *, integer *, + integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *), ccopy_(integer *, + singlecomplex *, integer *, singlecomplex *, integer *), ctrmm_(char *, char * + , char *, char *, integer *, integer *, singlecomplex *, singlecomplex *, + integer *, singlecomplex *, integer *), + caxpy_(integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, + integer *), ctrmv_(char *, char *, char *, integer *, singlecomplex *, + integer *, singlecomplex *, integer *), clarfg_( + integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), clacgv_( + integer *, singlecomplex *, integer *), clacpy_(char *, integer *, + integer *, singlecomplex *, integer *, singlecomplex *, integer *); /* -- LAPACK auxiliary routine (version 3.2.1) -- */ @@ -11205,7 +11205,7 @@ static real c_b2435 = .5f; Purpose ======= - CLAHR2 reduces the first NB columns of A complex general n-BY-(n-k+1) + CLAHR2 reduces the first NB columns of A singlecomplex general n-BY-(n-k+1) matrix A so that elements below the k-th subdiagonal are zero. The reduction is performed by an unitary similarity transformation Q' * A * Q. The routine returns the matrices V and T which determine @@ -11266,7 +11266,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in A(i+k+1:n,i), and tau in TAU(i). @@ -11479,7 +11479,7 @@ static real c_b2435 = .5f; } /* clahr2_ */ /* Subroutine */ int clals0_(integer *icompq, integer *nl, integer *nr, - integer *sqre, integer *nrhs, complex *b, integer *ldb, complex *bx, + integer *sqre, integer *nrhs, singlecomplex *b, integer *ldb, singlecomplex *bx, integer *ldbx, integer *perm, integer *givptr, integer *givcol, integer *ldgcol, real *givnum, integer *ldgnum, real *poles, real * difl, real *difr, real *z__, integer *k, real *c__, real *s, real * @@ -11490,7 +11490,7 @@ static real c_b2435 = .5f; givnum_offset, poles_dim1, poles_offset, b_dim1, b_offset, bx_dim1, bx_offset, i__1, i__2, i__3, i__4, i__5; real r__1; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, j, m, n; @@ -11500,15 +11500,15 @@ static real c_b2435 = .5f; static integer jrow; extern doublereal snrm2_(integer *, real *, integer *); static real diflj, difrj, dsigj; - extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, - complex *, integer *), sgemv_(char *, integer *, integer *, real * - , real *, integer *, real *, integer *, real *, real *, integer *), csrot_(integer *, complex *, integer *, complex *, + extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *), sgemv_(char *, integer *, integer *, real * + , real *, integer *, real *, integer *, real *, real *, integer *), csrot_(integer *, singlecomplex *, integer *, singlecomplex *, integer *, real *, real *); extern doublereal slamc3_(real *, real *); extern /* Subroutine */ int clascl_(char *, integer *, integer *, real *, - real *, integer *, integer *, complex *, integer *, integer *), csscal_(integer *, real *, complex *, integer *), - clacpy_(char *, integer *, integer *, complex *, integer *, - complex *, integer *), xerbla_(char *, integer *); + real *, integer *, integer *, singlecomplex *, integer *, integer *), csscal_(integer *, real *, singlecomplex *, integer *), + clacpy_(char *, integer *, integer *, singlecomplex *, integer *, + singlecomplex *, integer *), xerbla_(char *, integer *); static real dsigjp; @@ -11813,7 +11813,7 @@ static real c_b2435 = .5f; temp = snrm2_(k, &rwork[1], &c__1); /* - Since B and BX are complex, the following call to SGEMV + Since B and BX are singlecomplex, the following call to SGEMV is performed in two steps (real and imaginary parts). CALL SGEMV( 'T', K, NRHS, ONE, BX, LDBX, WORK, 1, ZERO, @@ -11917,7 +11917,7 @@ static real c_b2435 = .5f; } /* - Since B and BX are complex, the following call to SGEMV + Since B and BX are singlecomplex, the following call to SGEMV is performed in two steps (real and imaginary parts). CALL SGEMV( 'T', K, NRHS, ONE, B, LDB, WORK, 1, ZERO, @@ -12012,7 +12012,7 @@ static real c_b2435 = .5f; } /* clals0_ */ /* Subroutine */ int clalsa_(integer *icompq, integer *smlsiz, integer *n, - integer *nrhs, complex *b, integer *ldb, complex *bx, integer *ldbx, + integer *nrhs, singlecomplex *b, integer *ldb, singlecomplex *bx, integer *ldbx, real *u, integer *ldu, real *vt, integer *k, real *difl, real *difr, real *z__, real *poles, integer *givptr, integer *givcol, integer * ldgcol, integer *perm, real *givnum, real *c__, real *s, real *rwork, @@ -12024,7 +12024,7 @@ static real c_b2435 = .5f; poles_dim1, poles_offset, u_dim1, u_offset, vt_dim1, vt_offset, z_dim1, z_offset, b_dim1, b_offset, bx_dim1, bx_offset, i__1, i__2, i__3, i__4, i__5, i__6; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, j, i1, ic, lf, nd, ll, nl, nr, im1, nlf, nrf, lvl, @@ -12034,9 +12034,9 @@ static real c_b2435 = .5f; integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); static integer ndimr; - extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, - complex *, integer *), clals0_(integer *, integer *, integer *, - integer *, integer *, complex *, integer *, complex *, integer *, + extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *), clals0_(integer *, integer *, integer *, + integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, integer *, real *, real *, real *, integer *), xerbla_(char *, integer *), slasdt_(integer * @@ -12302,7 +12302,7 @@ static real c_b2435 = .5f; nrf = ic + 1; /* - Since B and BX are complex, the following call to SGEMM + Since B and BX are singlecomplex, the following call to SGEMM is performed in two steps (real and imaginary parts). CALL SGEMM( 'T', 'N', NL, NRHS, NL, ONE, U( NLF, 1 ), LDU, @@ -12356,7 +12356,7 @@ static real c_b2435 = .5f; } /* - Since B and BX are complex, the following call to SGEMM + Since B and BX are singlecomplex, the following call to SGEMM is performed in two steps (real and imaginary parts). CALL SGEMM( 'T', 'N', NR, NRHS, NR, ONE, U( NRF, 1 ), LDU, @@ -12546,7 +12546,7 @@ static real c_b2435 = .5f; nrf = ic + 1; /* - Since B and BX are complex, the following call to SGEMM is + Since B and BX are singlecomplex, the following call to SGEMM is performed in two steps (real and imaginary parts). CALL SGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU, @@ -12601,7 +12601,7 @@ static real c_b2435 = .5f; } /* - Since B and BX are complex, the following call to SGEMM is + Since B and BX are singlecomplex, the following call to SGEMM is performed in two steps (real and imaginary parts). CALL SGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU, @@ -12667,14 +12667,14 @@ static real c_b2435 = .5f; } /* clalsa_ */ /* Subroutine */ int clalsd_(char *uplo, integer *smlsiz, integer *n, integer - *nrhs, real *d__, real *e, complex *b, integer *ldb, real *rcond, - integer *rank, complex *work, real *rwork, integer *iwork, integer * + *nrhs, real *d__, real *e, singlecomplex *b, integer *ldb, real *rcond, + integer *rank, singlecomplex *work, real *rwork, integer *iwork, integer * info) { /* System generated locals */ integer b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5, i__6; real r__1; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer c__, i__, j, k; @@ -12695,27 +12695,27 @@ static real c_b2435 = .5f; integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); static integer irwib; - extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, - complex *, integer *); + extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *); static integer poles, sizei, irwrb, nsize; - extern /* Subroutine */ int csrot_(integer *, complex *, integer *, - complex *, integer *, real *, real *); + extern /* Subroutine */ int csrot_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *, real *, real *); static integer irwvt, icmpq1, icmpq2; extern /* Subroutine */ int clalsa_(integer *, integer *, integer *, - integer *, complex *, integer *, complex *, integer *, real *, + integer *, singlecomplex *, integer *, singlecomplex *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real * , real *, integer *, integer *), clascl_(char *, integer *, - integer *, real *, real *, integer *, integer *, complex *, + integer *, real *, real *, integer *, integer *, singlecomplex *, integer *, integer *); extern doublereal slamch_(char *); extern /* Subroutine */ int slasda_(integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real *, real *, integer *, integer *), - clacpy_(char *, integer *, integer *, complex *, integer *, - complex *, integer *), claset_(char *, integer *, integer - *, complex *, complex *, complex *, integer *), xerbla_( + clacpy_(char *, integer *, integer *, singlecomplex *, integer *, + singlecomplex *, integer *), claset_(char *, integer *, integer + *, singlecomplex *, singlecomplex *, singlecomplex *, integer *), xerbla_( char *, integer *), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer * ); @@ -12963,7 +12963,7 @@ static real c_b2435 = .5f; /* In the real version, B is passed to SLASDQ and multiplied - internally by Q'. Here B is complex and that product is + internally by Q'. Here B is singlecomplex and that product is computed below in two steps (real and imaginary parts). */ @@ -13027,7 +13027,7 @@ static real c_b2435 = .5f; } /* - Since B is complex, the following call to SGEMM is performed + Since B is singlecomplex, the following call to SGEMM is performed in two steps (real and imaginary parts). That is for V * B (in the real version of the code V' is stored in WORK). @@ -13199,7 +13199,7 @@ static real c_b2435 = .5f; /* In the real version, B is passed to SLASDQ and multiplied - internally by Q'. Here B is complex and that product is + internally by Q'. Here B is singlecomplex and that product is computed below in two steps (real and imaginary parts). */ @@ -13320,7 +13320,7 @@ static real c_b2435 = .5f; } else if (nsize <= *smlsiz) { /* - Since B and BX are complex, the following call to SGEMM + Since B and BX are singlecomplex, the following call to SGEMM is performed in two steps (real and imaginary parts). CALL SGEMM( 'T', 'N', NSIZE, NRHS, NSIZE, ONE, @@ -13404,7 +13404,7 @@ static real c_b2435 = .5f; } /* clalsd_ */ -doublereal clange_(char *norm, integer *m, integer *n, complex *a, integer * +doublereal clange_(char *norm, integer *m, integer *n, singlecomplex *a, integer * lda, real *work) { /* System generated locals */ @@ -13416,7 +13416,7 @@ doublereal clange_(char *norm, integer *m, integer *n, complex *a, integer * static real sum, scale; extern logical lsame_(char *, char *); static real value; - extern /* Subroutine */ int classq_(integer *, complex *, integer *, real + extern /* Subroutine */ int classq_(integer *, singlecomplex *, integer *, real *, real *); @@ -13432,7 +13432,7 @@ doublereal clange_(char *norm, integer *m, integer *n, complex *a, integer * CLANGE returns the value of the one norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a - complex matrix A. + singlecomplex matrix A. Description =========== @@ -13570,7 +13570,7 @@ doublereal clange_(char *norm, integer *m, integer *n, complex *a, integer * } /* clange_ */ -doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * +doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer * lda, real *work) { /* System generated locals */ @@ -13582,7 +13582,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * static real sum, absa, scale; extern logical lsame_(char *, char *); static real value; - extern /* Subroutine */ int classq_(integer *, complex *, integer *, real + extern /* Subroutine */ int classq_(integer *, singlecomplex *, integer *, real *, real *); @@ -13598,7 +13598,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * CLANHE returns the value of the one norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a - complex hermitian matrix A. + singlecomplex hermitian matrix A. Description =========== @@ -13803,48 +13803,48 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clanhe_ */ /* Subroutine */ int claqr0_(logical *wantt, logical *wantz, integer *n, - integer *ilo, integer *ihi, complex *h__, integer *ldh, complex *w, - integer *iloz, integer *ihiz, complex *z__, integer *ldz, complex * + integer *ilo, integer *ihi, singlecomplex *h__, integer *ldh, singlecomplex *w, + integer *iloz, integer *ihiz, singlecomplex *z__, integer *ldz, singlecomplex * work, integer *lwork, integer *info) { /* System generated locals */ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5; real r__1, r__2, r__3, r__4, r__5, r__6, r__7, r__8; - complex q__1, q__2, q__3, q__4, q__5; + singlecomplex q__1, q__2, q__3, q__4, q__5; /* Local variables */ static integer i__, k; static real s; - static complex aa, bb, cc, dd; + static singlecomplex aa, bb, cc, dd; static integer ld, nh, it, ks, kt, ku, kv, ls, ns, nw; - static complex tr2, det; + static singlecomplex tr2, det; static integer inf, kdu, nho, nve, kwh, nsr, nwr, kwv, ndec, ndfl, kbot, nmin; - static complex swap; + static singlecomplex swap; static integer ktop; - static complex zdum[1] /* was [1][1] */; + static singlecomplex zdum[1] /* was [1][1] */; static integer kacc22, itmax, nsmax, nwmax, kwtop; extern /* Subroutine */ int claqr3_(logical *, logical *, integer *, - integer *, integer *, integer *, complex *, integer *, integer *, - integer *, complex *, integer *, integer *, integer *, complex *, - complex *, integer *, integer *, complex *, integer *, integer *, - complex *, integer *, complex *, integer *), claqr4_(logical *, - logical *, integer *, integer *, integer *, complex *, integer *, - complex *, integer *, integer *, complex *, integer *, complex *, + integer *, integer *, integer *, singlecomplex *, integer *, integer *, + integer *, singlecomplex *, integer *, integer *, integer *, singlecomplex *, + singlecomplex *, integer *, integer *, singlecomplex *, integer *, integer *, + singlecomplex *, integer *, singlecomplex *, integer *), claqr4_(logical *, + logical *, integer *, integer *, integer *, singlecomplex *, integer *, + singlecomplex *, integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, integer *), claqr5_(logical *, logical *, integer *, - integer *, integer *, integer *, integer *, complex *, complex *, - integer *, integer *, integer *, complex *, integer *, complex *, - integer *, complex *, integer *, integer *, complex *, integer *, - integer *, complex *, integer *); + integer *, integer *, integer *, integer *, singlecomplex *, singlecomplex *, + integer *, integer *, integer *, singlecomplex *, integer *, singlecomplex *, + integer *, singlecomplex *, integer *, integer *, singlecomplex *, integer *, + integer *, singlecomplex *, integer *); static integer nibble; extern /* Subroutine */ int clahqr_(logical *, logical *, integer *, - integer *, integer *, complex *, integer *, complex *, integer *, - integer *, complex *, integer *, integer *), clacpy_(char *, - integer *, integer *, complex *, integer *, complex *, integer *); + integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, + integer *, singlecomplex *, integer *, integer *), clacpy_(char *, + integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static char jbcmpz[2]; - static complex rtdisc; + static singlecomplex rtdisc; static integer nwupbd; static logical sorted; static integer lwkopt; @@ -14585,17 +14585,17 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * return 0; } /* claqr0_ */ -/* Subroutine */ int claqr1_(integer *n, complex *h__, integer *ldh, complex * - s1, complex *s2, complex *v) +/* Subroutine */ int claqr1_(integer *n, singlecomplex *h__, integer *ldh, singlecomplex * + s1, singlecomplex *s2, singlecomplex *v) { /* System generated locals */ integer h_dim1, h_offset, i__1, i__2, i__3, i__4; real r__1, r__2, r__3, r__4, r__5, r__6; - complex q__1, q__2, q__3, q__4, q__5, q__6, q__7, q__8; + singlecomplex q__1, q__2, q__3, q__4, q__5, q__6, q__7, q__8; /* Local variables */ static real s; - static complex h21s, h31s; + static singlecomplex h21s, h31s; /* @@ -14753,52 +14753,52 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* claqr1_ */ /* Subroutine */ int claqr2_(logical *wantt, logical *wantz, integer *n, - integer *ktop, integer *kbot, integer *nw, complex *h__, integer *ldh, - integer *iloz, integer *ihiz, complex *z__, integer *ldz, integer * - ns, integer *nd, complex *sh, complex *v, integer *ldv, integer *nh, - complex *t, integer *ldt, integer *nv, complex *wv, integer *ldwv, - complex *work, integer *lwork) + integer *ktop, integer *kbot, integer *nw, singlecomplex *h__, integer *ldh, + integer *iloz, integer *ihiz, singlecomplex *z__, integer *ldz, integer * + ns, integer *nd, singlecomplex *sh, singlecomplex *v, integer *ldv, integer *nh, + singlecomplex *t, integer *ldt, integer *nv, singlecomplex *wv, integer *ldwv, + singlecomplex *work, integer *lwork) { /* System generated locals */ integer h_dim1, h_offset, t_dim1, t_offset, v_dim1, v_offset, wv_dim1, wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4; real r__1, r__2, r__3, r__4, r__5, r__6; - complex q__1, q__2; + singlecomplex q__1, q__2; /* Local variables */ static integer i__, j; - static complex s; + static singlecomplex s; static integer jw; static real foo; static integer kln; - static complex tau; + static singlecomplex tau; static integer knt; static real ulp; static integer lwk1, lwk2; - static complex beta; + static singlecomplex beta; static integer kcol, info, ifst, ilst, ltop, krow; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * - , integer *, complex *, complex *, integer *, complex *), - cgemm_(char *, char *, integer *, integer *, integer *, complex *, - complex *, integer *, complex *, integer *, complex *, complex *, - integer *), ccopy_(integer *, complex *, integer - *, complex *, integer *); + extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * + , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), + cgemm_(char *, char *, integer *, integer *, integer *, singlecomplex *, + singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, + integer *), ccopy_(integer *, singlecomplex *, integer + *, singlecomplex *, integer *); static integer infqr, kwtop; extern /* Subroutine */ int slabad_(real *, real *), cgehrd_(integer *, - integer *, integer *, complex *, integer *, complex *, complex *, - integer *, integer *), clarfg_(integer *, complex *, complex *, - integer *, complex *); + integer *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, + integer *, integer *), clarfg_(integer *, singlecomplex *, singlecomplex *, + integer *, singlecomplex *); extern doublereal slamch_(char *); extern /* Subroutine */ int clahqr_(logical *, logical *, integer *, - integer *, integer *, complex *, integer *, complex *, integer *, - integer *, complex *, integer *, integer *), clacpy_(char *, - integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex - *, complex *, integer *); + integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, + integer *, singlecomplex *, integer *, integer *), clacpy_(char *, + integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *), claset_(char *, integer *, integer *, singlecomplex *, singlecomplex + *, singlecomplex *, integer *); static real safmin, safmax; - extern /* Subroutine */ int ctrexc_(char *, integer *, complex *, integer - *, complex *, integer *, integer *, integer *, integer *), + extern /* Subroutine */ int ctrexc_(char *, integer *, singlecomplex *, integer + *, singlecomplex *, integer *, integer *, integer *, integer *), cunmhr_(char *, char *, integer *, integer *, integer *, integer - *, complex *, integer *, complex *, complex *, integer *, complex + *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, integer *); static real smlnum; static integer lwkopt; @@ -15327,57 +15327,57 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* claqr2_ */ /* Subroutine */ int claqr3_(logical *wantt, logical *wantz, integer *n, - integer *ktop, integer *kbot, integer *nw, complex *h__, integer *ldh, - integer *iloz, integer *ihiz, complex *z__, integer *ldz, integer * - ns, integer *nd, complex *sh, complex *v, integer *ldv, integer *nh, - complex *t, integer *ldt, integer *nv, complex *wv, integer *ldwv, - complex *work, integer *lwork) + integer *ktop, integer *kbot, integer *nw, singlecomplex *h__, integer *ldh, + integer *iloz, integer *ihiz, singlecomplex *z__, integer *ldz, integer * + ns, integer *nd, singlecomplex *sh, singlecomplex *v, integer *ldv, integer *nh, + singlecomplex *t, integer *ldt, integer *nv, singlecomplex *wv, integer *ldwv, + singlecomplex *work, integer *lwork) { /* System generated locals */ integer h_dim1, h_offset, t_dim1, t_offset, v_dim1, v_offset, wv_dim1, wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4; real r__1, r__2, r__3, r__4, r__5, r__6; - complex q__1, q__2; + singlecomplex q__1, q__2; /* Local variables */ static integer i__, j; - static complex s; + static singlecomplex s; static integer jw; static real foo; static integer kln; - static complex tau; + static singlecomplex tau; static integer knt; static real ulp; static integer lwk1, lwk2, lwk3; - static complex beta; + static singlecomplex beta; static integer kcol, info, nmin, ifst, ilst, ltop, krow; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * - , integer *, complex *, complex *, integer *, complex *), - cgemm_(char *, char *, integer *, integer *, integer *, complex *, - complex *, integer *, complex *, integer *, complex *, complex *, - integer *), ccopy_(integer *, complex *, integer - *, complex *, integer *); + extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * + , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), + cgemm_(char *, char *, integer *, integer *, integer *, singlecomplex *, + singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, + integer *), ccopy_(integer *, singlecomplex *, integer + *, singlecomplex *, integer *); static integer infqr, kwtop; extern /* Subroutine */ int claqr4_(logical *, logical *, integer *, - integer *, integer *, complex *, integer *, complex *, integer *, - integer *, complex *, integer *, complex *, integer *, integer *), + integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, + integer *, singlecomplex *, integer *, singlecomplex *, integer *, integer *), slabad_(real *, real *), cgehrd_(integer *, integer *, integer *, - complex *, integer *, complex *, complex *, integer *, integer *) - , clarfg_(integer *, complex *, complex *, integer *, complex *); + singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer *) + , clarfg_(integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *); extern doublereal slamch_(char *); extern /* Subroutine */ int clahqr_(logical *, logical *, integer *, - integer *, integer *, complex *, integer *, complex *, integer *, - integer *, complex *, integer *, integer *), clacpy_(char *, - integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex - *, complex *, integer *); + integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, + integer *, singlecomplex *, integer *, integer *), clacpy_(char *, + integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *), claset_(char *, integer *, integer *, singlecomplex *, singlecomplex + *, singlecomplex *, integer *); static real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static real safmax; - extern /* Subroutine */ int ctrexc_(char *, integer *, complex *, integer - *, complex *, integer *, integer *, integer *, integer *), + extern /* Subroutine */ int ctrexc_(char *, integer *, singlecomplex *, integer + *, singlecomplex *, integer *, integer *, integer *, integer *), cunmhr_(char *, char *, integer *, integer *, integer *, integer - *, complex *, integer *, complex *, complex *, integer *, complex + *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, integer *); static real smlnum; static integer lwkopt; @@ -15920,45 +15920,45 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* claqr3_ */ /* Subroutine */ int claqr4_(logical *wantt, logical *wantz, integer *n, - integer *ilo, integer *ihi, complex *h__, integer *ldh, complex *w, - integer *iloz, integer *ihiz, complex *z__, integer *ldz, complex * + integer *ilo, integer *ihi, singlecomplex *h__, integer *ldh, singlecomplex *w, + integer *iloz, integer *ihiz, singlecomplex *z__, integer *ldz, singlecomplex * work, integer *lwork, integer *info) { /* System generated locals */ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5; real r__1, r__2, r__3, r__4, r__5, r__6, r__7, r__8; - complex q__1, q__2, q__3, q__4, q__5; + singlecomplex q__1, q__2, q__3, q__4, q__5; /* Local variables */ static integer i__, k; static real s; - static complex aa, bb, cc, dd; + static singlecomplex aa, bb, cc, dd; static integer ld, nh, it, ks, kt, ku, kv, ls, ns, nw; - static complex tr2, det; + static singlecomplex tr2, det; static integer inf, kdu, nho, nve, kwh, nsr, nwr, kwv, ndec, ndfl, kbot, nmin; - static complex swap; + static singlecomplex swap; static integer ktop; - static complex zdum[1] /* was [1][1] */; + static singlecomplex zdum[1] /* was [1][1] */; static integer kacc22, itmax, nsmax, nwmax, kwtop; extern /* Subroutine */ int claqr2_(logical *, logical *, integer *, - integer *, integer *, integer *, complex *, integer *, integer *, - integer *, complex *, integer *, integer *, integer *, complex *, - complex *, integer *, integer *, complex *, integer *, integer *, - complex *, integer *, complex *, integer *), claqr5_(logical *, + integer *, integer *, integer *, singlecomplex *, integer *, integer *, + integer *, singlecomplex *, integer *, integer *, integer *, singlecomplex *, + singlecomplex *, integer *, integer *, singlecomplex *, integer *, integer *, + singlecomplex *, integer *, singlecomplex *, integer *), claqr5_(logical *, logical *, integer *, integer *, integer *, integer *, integer *, - complex *, complex *, integer *, integer *, integer *, complex *, - integer *, complex *, integer *, complex *, integer *, integer *, - complex *, integer *, integer *, complex *, integer *); + singlecomplex *, singlecomplex *, integer *, integer *, integer *, singlecomplex *, + integer *, singlecomplex *, integer *, singlecomplex *, integer *, integer *, + singlecomplex *, integer *, integer *, singlecomplex *, integer *); static integer nibble; extern /* Subroutine */ int clahqr_(logical *, logical *, integer *, - integer *, integer *, complex *, integer *, complex *, integer *, - integer *, complex *, integer *, integer *), clacpy_(char *, - integer *, integer *, complex *, integer *, complex *, integer *); + integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, + integer *, singlecomplex *, integer *, integer *), clacpy_(char *, + integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static char jbcmpz[2]; - static complex rtdisc; + static singlecomplex rtdisc; static integer nwupbd; static logical sorted; static integer lwkopt; @@ -16701,10 +16701,10 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* claqr4_ */ /* Subroutine */ int claqr5_(logical *wantt, logical *wantz, integer *kacc22, - integer *n, integer *ktop, integer *kbot, integer *nshfts, complex *s, - complex *h__, integer *ldh, integer *iloz, integer *ihiz, complex * - z__, integer *ldz, complex *v, integer *ldv, complex *u, integer *ldu, - integer *nv, complex *wv, integer *ldwv, integer *nh, complex *wh, + integer *n, integer *ktop, integer *kbot, integer *nshfts, singlecomplex *s, + singlecomplex *h__, integer *ldh, integer *iloz, integer *ihiz, singlecomplex * + z__, integer *ldz, singlecomplex *v, integer *ldv, singlecomplex *u, integer *ldu, + integer *nv, singlecomplex *wv, integer *ldwv, integer *nh, singlecomplex *wh, integer *ldwh) { /* System generated locals */ @@ -16712,39 +16712,39 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * wh_offset, wv_dim1, wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10, i__11; real r__1, r__2, r__3, r__4, r__5, r__6, r__7, r__8, r__9, r__10; - complex q__1, q__2, q__3, q__4, q__5, q__6, q__7, q__8; + singlecomplex q__1, q__2, q__3, q__4, q__5, q__6, q__7, q__8; /* Local variables */ static integer j, k, m, i2, j2, i4, j4, k1; static real h11, h12, h21, h22; static integer m22, ns, nu; - static complex vt[3]; + static singlecomplex vt[3]; static real scl; static integer kdu, kms; static real ulp; static integer knz, kzs; static real tst1, tst2; - static complex beta; + static singlecomplex beta; static logical blk22, bmp22; static integer mend, jcol, jlen, jbot, mbot, jtop, jrow, mtop; - static complex alpha; + static singlecomplex alpha; static logical accum; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, complex *, complex *, integer *, complex *, integer *, - complex *, complex *, integer *); + integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *); static integer ndcol, incol, krcol, nbmps; extern /* Subroutine */ int ctrmm_(char *, char *, char *, char *, - integer *, integer *, complex *, complex *, integer *, complex *, + integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *), claqr1_(integer *, - complex *, integer *, complex *, complex *, complex *), slabad_( - real *, real *), clarfg_(integer *, complex *, complex *, integer - *, complex *); + singlecomplex *, integer *, singlecomplex *, singlecomplex *, singlecomplex *), slabad_( + real *, real *), clarfg_(integer *, singlecomplex *, singlecomplex *, integer + *, singlecomplex *); extern doublereal slamch_(char *); - extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex - *, integer *, complex *, integer *), claset_(char *, - integer *, integer *, complex *, complex *, complex *, integer *); + extern /* Subroutine */ int clacpy_(char *, integer *, integer *, singlecomplex + *, integer *, singlecomplex *, integer *), claset_(char *, + integer *, integer *, singlecomplex *, singlecomplex *, singlecomplex *, integer *); static real safmin, safmax; - static complex refsum; + static singlecomplex refsum; static integer mstart; static real smlnum; @@ -18048,13 +18048,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* claqr5_ */ /* Subroutine */ int clarcm_(integer *m, integer *n, real *a, integer *lda, - complex *b, integer *ldb, complex *c__, integer *ldc, real *rwork) + singlecomplex *b, integer *ldb, singlecomplex *c__, integer *ldc, real *rwork) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5; real r__1; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, j, l; @@ -18075,8 +18075,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * CLARCM performs a very simple matrix-matrix multiplication: C := A * B, - where A is M by M and real; B is M by N and complex; - C is M by N and complex. + where A is M by M and real; B is M by N and singlecomplex; + C is M by N and singlecomplex. Arguments ========= @@ -18191,25 +18191,25 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clarcm_ */ -/* Subroutine */ int clarf_(char *side, integer *m, integer *n, complex *v, - integer *incv, complex *tau, complex *c__, integer *ldc, complex * +/* Subroutine */ int clarf_(char *side, integer *m, integer *n, singlecomplex *v, + integer *incv, singlecomplex *tau, singlecomplex *c__, integer *ldc, singlecomplex * work) { /* System generated locals */ integer c_dim1, c_offset, i__1; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__; static logical applyleft; - extern /* Subroutine */ int cgerc_(integer *, integer *, complex *, - complex *, integer *, complex *, integer *, complex *, integer *), - cgemv_(char *, integer *, integer *, complex *, complex *, - integer *, complex *, integer *, complex *, complex *, integer *); + extern /* Subroutine */ int cgerc_(integer *, integer *, singlecomplex *, + singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, integer *), + cgemv_(char *, integer *, integer *, singlecomplex *, singlecomplex *, + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *); extern logical lsame_(char *, char *); static integer lastc, lastv; - extern integer ilaclc_(integer *, integer *, complex *, integer *), - ilaclr_(integer *, integer *, complex *, integer *); + extern integer ilaclc_(integer *, integer *, singlecomplex *, integer *), + ilaclr_(integer *, integer *, singlecomplex *, integer *); /* @@ -18222,13 +18222,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CLARF applies a complex elementary reflector H to a complex M-by-N + CLARF applies a singlecomplex elementary reflector H to a singlecomplex M-by-N matrix C, from either the left or the right. H is represented in the form H = I - tau * v * v' - where tau is a complex scalar and v is a complex vector. + where tau is a singlecomplex scalar and v is a singlecomplex vector. If tau = 0, then H is taken to be the unit matrix. @@ -18364,30 +18364,30 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clarf_ */ /* Subroutine */ int clarfb_(char *side, char *trans, char *direct, char * - storev, integer *m, integer *n, integer *k, complex *v, integer *ldv, - complex *t, integer *ldt, complex *c__, integer *ldc, complex *work, + storev, integer *m, integer *n, integer *k, singlecomplex *v, integer *ldv, + singlecomplex *t, integer *ldt, singlecomplex *c__, integer *ldc, singlecomplex *work, integer *ldwork) { /* System generated locals */ integer c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1, work_offset, i__1, i__2, i__3, i__4, i__5; - complex q__1, q__2; + singlecomplex q__1, q__2; /* Local variables */ static integer i__, j; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, complex *, complex *, integer *, complex *, integer *, - complex *, complex *, integer *); + integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *); extern logical lsame_(char *, char *); static integer lastc; - extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, - complex *, integer *), ctrmm_(char *, char *, char *, char *, - integer *, integer *, complex *, complex *, integer *, complex *, + extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *), ctrmm_(char *, char *, char *, char *, + integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *); static integer lastv; - extern integer ilaclc_(integer *, integer *, complex *, integer *); - extern /* Subroutine */ int clacgv_(integer *, complex *, integer *); - extern integer ilaclr_(integer *, integer *, complex *, integer *); + extern integer ilaclc_(integer *, integer *, singlecomplex *, integer *); + extern /* Subroutine */ int clacgv_(integer *, singlecomplex *, integer *); + extern integer ilaclr_(integer *, integer *, singlecomplex *, integer *); static char transt[1]; @@ -18401,8 +18401,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CLARFB applies a complex block reflector H or its transpose H' to a - complex M-by-N matrix C, from either the left or the right. + CLARFB applies a singlecomplex block reflector H or its transpose H' to a + singlecomplex M-by-N matrix C, from either the left or the right. Arguments ========= @@ -19205,25 +19205,25 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clarfb_ */ -/* Subroutine */ int clarfg_(integer *n, complex *alpha, complex *x, integer * - incx, complex *tau) +/* Subroutine */ int clarfg_(integer *n, singlecomplex *alpha, singlecomplex *x, integer * + incx, singlecomplex *tau) { /* System generated locals */ integer i__1; real r__1, r__2; - complex q__1, q__2; + singlecomplex q__1, q__2; /* Local variables */ static integer j, knt; static real beta; - extern /* Subroutine */ int cscal_(integer *, complex *, complex *, + extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, integer *); static real alphi, alphr, xnorm; - extern doublereal scnrm2_(integer *, complex *, integer *), slapy3_(real * + extern doublereal scnrm2_(integer *, singlecomplex *, integer *), slapy3_(real * , real *, real *); - extern /* Complex */ VOID cladiv_(complex *, complex *, complex *); + extern /* Complex */ VOID cladiv_(singlecomplex *, singlecomplex *, singlecomplex *); extern doublereal slamch_(char *); - extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer + extern /* Subroutine */ int csscal_(integer *, real *, singlecomplex *, integer *); static real safmin, rsafmn; @@ -19238,19 +19238,19 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CLARFG generates a complex elementary reflector H of order n, such + CLARFG generates a singlecomplex elementary reflector H of order n, such that H' * ( alpha ) = ( beta ), H' * H = I. ( x ) ( 0 ) where alpha and beta are scalars, with beta real, and x is an - (n-1)-element complex vector. H is represented in the form + (n-1)-element singlecomplex vector. H is represented in the form H = I - tau * ( 1 ) * ( 1 v' ) , ( v ) - where tau is a complex scalar and v is a complex (n-1)-element + where tau is a singlecomplex scalar and v is a singlecomplex (n-1)-element vector. Note that H is not hermitian. If the elements of x are all zero and alpha is real, then tau = 0 @@ -19363,22 +19363,22 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clarfg_ */ /* Subroutine */ int clarft_(char *direct, char *storev, integer *n, integer * - k, complex *v, integer *ldv, complex *tau, complex *t, integer *ldt) + k, singlecomplex *v, integer *ldv, singlecomplex *tau, singlecomplex *t, integer *ldt) { /* System generated locals */ integer t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3, i__4; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, j, prevlastv; - static complex vii; - extern /* Subroutine */ int cgemv_(char *, integer *, integer *, complex * - , complex *, integer *, complex *, integer *, complex *, complex * + static singlecomplex vii; + extern /* Subroutine */ int cgemv_(char *, integer *, integer *, singlecomplex * + , singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * , integer *); extern logical lsame_(char *, char *); static integer lastv; extern /* Subroutine */ int ctrmv_(char *, char *, char *, integer *, - complex *, integer *, complex *, integer *), clacgv_(integer *, complex *, integer *); + singlecomplex *, integer *, singlecomplex *, integer *), clacgv_(integer *, singlecomplex *, integer *); /* @@ -19391,7 +19391,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CLARFT forms the triangular factor T of a complex block reflector H + CLARFT forms the triangular factor T of a singlecomplex block reflector H of order n, which is defined as a product of k elementary reflectors. If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular; @@ -19703,21 +19703,21 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clarft_ */ -/* Subroutine */ int clartg_(complex *f, complex *g, real *cs, complex *sn, - complex *r__) +/* Subroutine */ int clartg_(singlecomplex *f, singlecomplex *g, real *cs, singlecomplex *sn, + singlecomplex *r__) { /* System generated locals */ integer i__1; real r__1, r__2, r__3, r__4, r__5, r__6, r__7, r__8, r__9, r__10; - complex q__1, q__2, q__3; + singlecomplex q__1, q__2, q__3; /* Local variables */ static real d__; static integer i__; static real f2, g2; - static complex ff; + static singlecomplex ff; static real di, dr; - static complex fs, gs; + static singlecomplex fs, gs; static real f2s, g2s, eps, scale; static integer count; static real safmn2, safmx2; @@ -19850,7 +19850,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * r__3 = r_imag(g); r__1 = slapy2_(&r__2, &r__3); r__->r = r__1, r__->i = 0.f; -/* Do complex/real division explicitly with two real divisions */ +/* Do singlecomplex/real division explicitly with two real divisions */ r__1 = gs.r; r__2 = r_imag(&gs); d__ = slapy2_(&r__1, &r__2); @@ -19880,7 +19880,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * *cs = f2s / g2s; /* Make sure abs(FF) = 1 - Do complex/real division explicitly with 2 real divisions + Do singlecomplex/real division explicitly with 2 real divisions Computing MAX */ r__3 = (r__1 = f->r, dabs(r__1)), r__4 = (r__2 = r_imag(f), dabs(r__2) @@ -19922,14 +19922,14 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * */ f2s = sqrt(g2 / f2 + 1.f); -/* Do the F2S(real)*FS(complex) multiply with two real multiplies */ +/* Do the F2S(real)*FS(singlecomplex) multiply with two real multiplies */ r__1 = f2s * fs.r; r__2 = f2s * r_imag(&fs); q__1.r = r__1, q__1.i = r__2; r__->r = q__1.r, r__->i = q__1.i; *cs = 1.f / f2s; d__ = f2 + g2; -/* Do complex/real division explicitly with two real divisions */ +/* Do singlecomplex/real division explicitly with two real divisions */ r__1 = r__->r / d__; r__2 = r_imag(r__) / d__; q__1.r = r__1, q__1.i = r__2; @@ -19963,12 +19963,12 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clartg_ */ /* Subroutine */ int clascl_(char *type__, integer *kl, integer *ku, real * - cfrom, real *cto, integer *m, integer *n, complex *a, integer *lda, + cfrom, real *cto, integer *m, integer *n, singlecomplex *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, j, k1, k2, k3, k4; @@ -19996,7 +19996,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CLASCL multiplies the M by N complex matrix A by the real scalar + CLASCL multiplies the M by N singlecomplex matrix A by the real scalar CTO/CFROM. This is done without over/underflow as long as the final result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that A may be full, upper triangular, lower triangular, upper Hessenberg, @@ -20317,8 +20317,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clascl_ */ -/* Subroutine */ int claset_(char *uplo, integer *m, integer *n, complex * - alpha, complex *beta, complex *a, integer *lda) +/* Subroutine */ int claset_(char *uplo, integer *m, integer *n, singlecomplex * + alpha, singlecomplex *beta, singlecomplex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; @@ -20464,15 +20464,15 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* claset_ */ /* Subroutine */ int clasr_(char *side, char *pivot, char *direct, integer *m, - integer *n, real *c__, real *s, complex *a, integer *lda) + integer *n, real *c__, real *s, singlecomplex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; - complex q__1, q__2, q__3; + singlecomplex q__1, q__2, q__3; /* Local variables */ static integer i__, j, info; - static complex temp; + static singlecomplex temp; extern logical lsame_(char *, char *); static real ctemp, stemp; extern /* Subroutine */ int xerbla_(char *, integer *); @@ -20488,7 +20488,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CLASR applies a sequence of real plane rotations to a complex matrix + CLASR applies a sequence of real plane rotations to a singlecomplex matrix A, from either the left or the right. When SIDE = 'L', the transformation takes the form @@ -21046,7 +21046,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clasr_ */ -/* Subroutine */ int classq_(integer *n, complex *x, integer *incx, real * +/* Subroutine */ int classq_(integer *n, singlecomplex *x, integer *incx, real * scale, real *sumsq) { /* System generated locals */ @@ -21159,7 +21159,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* classq_ */ -/* Subroutine */ int claswp_(integer *n, complex *a, integer *lda, integer * +/* Subroutine */ int claswp_(integer *n, singlecomplex *a, integer *lda, integer * k1, integer *k2, integer *ipiv, integer *incx) { /* System generated locals */ @@ -21167,7 +21167,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * /* Local variables */ static integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc; - static complex temp; + static singlecomplex temp; /* @@ -21307,30 +21307,30 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* claswp_ */ -/* Subroutine */ int clatrd_(char *uplo, integer *n, integer *nb, complex *a, - integer *lda, real *e, complex *tau, complex *w, integer *ldw) +/* Subroutine */ int clatrd_(char *uplo, integer *n, integer *nb, singlecomplex *a, + integer *lda, real *e, singlecomplex *tau, singlecomplex *w, integer *ldw) { /* System generated locals */ integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3; real r__1; - complex q__1, q__2, q__3, q__4; + singlecomplex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__, iw; - static complex alpha; - extern /* Subroutine */ int cscal_(integer *, complex *, complex *, + static singlecomplex alpha; + extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, integer *); - extern /* Complex */ VOID cdotc_(complex *, integer *, complex *, integer - *, complex *, integer *); - extern /* Subroutine */ int cgemv_(char *, integer *, integer *, complex * - , complex *, integer *, complex *, integer *, complex *, complex * - , integer *), chemv_(char *, integer *, complex *, - complex *, integer *, complex *, integer *, complex *, complex *, + extern /* Complex */ VOID cdotc_(singlecomplex *, integer *, singlecomplex *, integer + *, singlecomplex *, integer *); + extern /* Subroutine */ int cgemv_(char *, integer *, integer *, singlecomplex * + , singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * + , integer *), chemv_(char *, integer *, singlecomplex *, + singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *); extern logical lsame_(char *, char *); - extern /* Subroutine */ int caxpy_(integer *, complex *, complex *, - integer *, complex *, integer *), clarfg_(integer *, complex *, - complex *, integer *, complex *), clacgv_(integer *, complex *, + extern /* Subroutine */ int caxpy_(integer *, singlecomplex *, singlecomplex *, + integer *, singlecomplex *, integer *), clarfg_(integer *, singlecomplex *, + singlecomplex *, integer *, singlecomplex *), clacgv_(integer *, singlecomplex *, integer *); @@ -21344,7 +21344,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CLATRD reduces NB rows and columns of a complex Hermitian matrix A to + CLATRD reduces NB rows and columns of a singlecomplex Hermitian matrix A to Hermitian tridiagonal form by a unitary similarity transformation Q' * A * Q, and returns the matrices V and W which are needed to apply the transformation to the unreduced part of A. @@ -21425,7 +21425,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i), and tau in TAU(i-1). @@ -21438,7 +21438,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * H(i) = I - tau * v * v' - where tau is a complex scalar, and v is a complex vector with + where tau is a singlecomplex scalar, and v is a singlecomplex vector with v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i), and tau in TAU(i). @@ -21699,13 +21699,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clatrd_ */ /* Subroutine */ int clatrs_(char *uplo, char *trans, char *diag, char * - normin, integer *n, complex *a, integer *lda, complex *x, real *scale, + normin, integer *n, singlecomplex *a, integer *lda, singlecomplex *x, real *scale, real *cnorm, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; real r__1, r__2, r__3, r__4; - complex q__1, q__2, q__3, q__4; + singlecomplex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__, j; @@ -21714,31 +21714,31 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * static real xbnd; static integer imax; static real tmax; - static complex tjjs; + static singlecomplex tjjs; static real xmax, grow; - extern /* Complex */ VOID cdotc_(complex *, integer *, complex *, integer - *, complex *, integer *); + extern /* Complex */ VOID cdotc_(singlecomplex *, integer *, singlecomplex *, integer + *, singlecomplex *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *); static real tscal; - static complex uscal; + static singlecomplex uscal; static integer jlast; - extern /* Complex */ VOID cdotu_(complex *, integer *, complex *, integer - *, complex *, integer *); - static complex csumj; - extern /* Subroutine */ int caxpy_(integer *, complex *, complex *, - integer *, complex *, integer *); + extern /* Complex */ VOID cdotu_(singlecomplex *, integer *, singlecomplex *, integer + *, singlecomplex *, integer *); + static singlecomplex csumj; + extern /* Subroutine */ int caxpy_(integer *, singlecomplex *, singlecomplex *, + integer *, singlecomplex *, integer *); static logical upper; extern /* Subroutine */ int ctrsv_(char *, char *, char *, integer *, - complex *, integer *, complex *, integer *), slabad_(real *, real *); - extern integer icamax_(integer *, complex *, integer *); - extern /* Complex */ VOID cladiv_(complex *, complex *, complex *); + singlecomplex *, integer *, singlecomplex *, integer *), slabad_(real *, real *); + extern integer icamax_(integer *, singlecomplex *, integer *); + extern /* Complex */ VOID cladiv_(singlecomplex *, singlecomplex *, singlecomplex *); extern doublereal slamch_(char *); - extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer + extern /* Subroutine */ int csscal_(integer *, real *, singlecomplex *, integer *), xerbla_(char *, integer *); static real bignum; extern integer isamax_(integer *, real *, integer *); - extern doublereal scasum_(integer *, complex *, integer *); + extern doublereal scasum_(integer *, singlecomplex *, integer *); static logical notran; static integer jfirst; static real smlnum; @@ -22860,26 +22860,26 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clatrs_ */ -/* Subroutine */ int clauu2_(char *uplo, integer *n, complex *a, integer *lda, +/* Subroutine */ int clauu2_(char *uplo, integer *n, singlecomplex *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; real r__1; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__; static real aii; - extern /* Complex */ VOID cdotc_(complex *, integer *, complex *, integer - *, complex *, integer *); + extern /* Complex */ VOID cdotc_(singlecomplex *, integer *, singlecomplex *, integer + *, singlecomplex *, integer *); extern logical lsame_(char *, char *); - extern /* Subroutine */ int cgemv_(char *, integer *, integer *, complex * - , complex *, integer *, complex *, integer *, complex *, complex * + extern /* Subroutine */ int cgemv_(char *, integer *, integer *, singlecomplex * + , singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * , integer *); static logical upper; - extern /* Subroutine */ int clacgv_(integer *, complex *, integer *), - csscal_(integer *, real *, complex *, integer *), xerbla_(char *, + extern /* Subroutine */ int clacgv_(integer *, singlecomplex *, integer *), + csscal_(integer *, real *, singlecomplex *, integer *), xerbla_(char *, integer *); @@ -23032,7 +23032,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clauu2_ */ -/* Subroutine */ int clauum_(char *uplo, integer *n, complex *a, integer *lda, +/* Subroutine */ int clauum_(char *uplo, integer *n, singlecomplex *a, integer *lda, integer *info) { /* System generated locals */ @@ -23041,16 +23041,16 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * /* Local variables */ static integer i__, ib, nb; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, complex *, complex *, integer *, complex *, integer *, - complex *, complex *, integer *), cherk_(char *, - char *, integer *, integer *, real *, complex *, integer *, real * - , complex *, integer *); + integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *), cherk_(char *, + char *, integer *, integer *, real *, singlecomplex *, integer *, real * + , singlecomplex *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ int ctrmm_(char *, char *, char *, char *, - integer *, integer *, complex *, complex *, integer *, complex *, + integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *); static logical upper; - extern /* Subroutine */ int clauu2_(char *, integer *, complex *, integer + extern /* Subroutine */ int clauu2_(char *, integer *, singlecomplex *, integer *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -23217,26 +23217,26 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* clauum_ */ -/* Subroutine */ int cpotf2_(char *uplo, integer *n, complex *a, integer *lda, +/* Subroutine */ int cpotf2_(char *uplo, integer *n, singlecomplex *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; real r__1; - complex q__1, q__2; + singlecomplex q__1, q__2; /* Local variables */ static integer j; static real ajj; - extern /* Complex */ VOID cdotc_(complex *, integer *, complex *, integer - *, complex *, integer *); + extern /* Complex */ VOID cdotc_(singlecomplex *, integer *, singlecomplex *, integer + *, singlecomplex *, integer *); extern logical lsame_(char *, char *); - extern /* Subroutine */ int cgemv_(char *, integer *, integer *, complex * - , complex *, integer *, complex *, integer *, complex *, complex * + extern /* Subroutine */ int cgemv_(char *, integer *, integer *, singlecomplex * + , singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * , integer *); static logical upper; - extern /* Subroutine */ int clacgv_(integer *, complex *, integer *), - csscal_(integer *, real *, complex *, integer *), xerbla_(char *, + extern /* Subroutine */ int clacgv_(integer *, singlecomplex *, integer *), + csscal_(integer *, real *, singlecomplex *, integer *), xerbla_(char *, integer *); extern logical sisnan_(real *); @@ -23251,7 +23251,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CPOTF2 computes the Cholesky factorization of a complex Hermitian + CPOTF2 computes the Cholesky factorization of a singlecomplex Hermitian positive definite matrix A. The factorization has the form @@ -23428,26 +23428,26 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cpotf2_ */ -/* Subroutine */ int cpotrf_(char *uplo, integer *n, complex *a, integer *lda, +/* Subroutine */ int cpotrf_(char *uplo, integer *n, singlecomplex *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer j, jb, nb; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, complex *, complex *, integer *, complex *, integer *, - complex *, complex *, integer *), cherk_(char *, - char *, integer *, integer *, real *, complex *, integer *, real * - , complex *, integer *); + integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *), cherk_(char *, + char *, integer *, integer *, real *, singlecomplex *, integer *, real * + , singlecomplex *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ int ctrsm_(char *, char *, char *, char *, - integer *, integer *, complex *, complex *, integer *, complex *, + integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *); static logical upper; - extern /* Subroutine */ int cpotf2_(char *, integer *, complex *, integer + extern /* Subroutine */ int cpotf2_(char *, integer *, singlecomplex *, integer *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -23463,7 +23463,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CPOTRF computes the Cholesky factorization of a complex Hermitian + CPOTRF computes the Cholesky factorization of a singlecomplex Hermitian positive definite matrix A. The factorization has the form @@ -23649,7 +23649,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cpotrf_ */ -/* Subroutine */ int cpotri_(char *uplo, integer *n, complex *a, integer *lda, +/* Subroutine */ int cpotri_(char *uplo, integer *n, singlecomplex *a, integer *lda, integer *info) { /* System generated locals */ @@ -23658,8 +23658,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *), clauum_( - char *, integer *, complex *, integer *, integer *), - ctrtri_(char *, char *, integer *, complex *, integer *, integer * + char *, integer *, singlecomplex *, integer *, integer *), + ctrtri_(char *, char *, integer *, singlecomplex *, integer *, integer * ); @@ -23673,7 +23673,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CPOTRI computes the inverse of a complex Hermitian positive definite + CPOTRI computes the inverse of a singlecomplex Hermitian positive definite matrix A using the Cholesky factorization A = U**H*U or A = L*L**H computed by CPOTRF. @@ -23752,8 +23752,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cpotri_ */ -/* Subroutine */ int cpotrs_(char *uplo, integer *n, integer *nrhs, complex * - a, integer *lda, complex *b, integer *ldb, integer *info) +/* Subroutine */ int cpotrs_(char *uplo, integer *n, integer *nrhs, singlecomplex * + a, integer *lda, singlecomplex *b, integer *ldb, integer *info) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1; @@ -23761,7 +23761,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ int ctrsm_(char *, char *, char *, char *, - integer *, integer *, complex *, complex *, integer *, complex *, + integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *); static logical upper; extern /* Subroutine */ int xerbla_(char *, integer *); @@ -23891,16 +23891,16 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cpotrs_ */ -/* Subroutine */ int crot_(integer *n, complex *cx, integer *incx, complex * - cy, integer *incy, real *c__, complex *s) +/* Subroutine */ int crot_(integer *n, singlecomplex *cx, integer *incx, singlecomplex * + cy, integer *incy, real *c__, singlecomplex *s) { /* System generated locals */ integer i__1, i__2, i__3, i__4; - complex q__1, q__2, q__3, q__4; + singlecomplex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__, ix, iy; - static complex stemp; + static singlecomplex stemp; /* @@ -23914,7 +23914,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * ======= CROT applies a plane rotation, where the cos (C) is real and the - sin (S) is complex, and the vectors CX and CY are complex. + sin (S) is singlecomplex, and the vectors CX and CY are singlecomplex. Arguments ========= @@ -24024,7 +24024,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* crot_ */ /* Subroutine */ int cstedc_(char *compz, integer *n, real *d__, real *e, - complex *z__, integer *ldz, complex *work, integer *lwork, real * + singlecomplex *z__, integer *ldz, singlecomplex *work, integer *lwork, real * rwork, integer *lrwork, integer *iwork, integer *liwork, integer * info) { @@ -24038,18 +24038,18 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * static integer ii, ll, lgn; static real eps, tiny; extern logical lsame_(char *, char *); - extern /* Subroutine */ int cswap_(integer *, complex *, integer *, - complex *, integer *); + extern /* Subroutine */ int cswap_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *); static integer lwmin; extern /* Subroutine */ int claed0_(integer *, integer *, real *, real *, - complex *, integer *, complex *, integer *, real *, integer *, + singlecomplex *, integer *, singlecomplex *, integer *, real *, integer *, integer *); static integer start; - extern /* Subroutine */ int clacrm_(integer *, integer *, complex *, - integer *, real *, integer *, complex *, integer *, real *); + extern /* Subroutine */ int clacrm_(integer *, integer *, singlecomplex *, + integer *, real *, integer *, singlecomplex *, integer *, real *); extern doublereal slamch_(char *); - extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex - *, integer *, complex *, integer *), xerbla_(char *, + extern /* Subroutine */ int clacpy_(char *, integer *, integer *, singlecomplex + *, integer *, singlecomplex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -24060,7 +24060,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * real *, integer *); static integer liwmin, icompz; extern /* Subroutine */ int csteqr_(char *, integer *, real *, real *, - complex *, integer *, real *, integer *); + singlecomplex *, integer *, real *, integer *); static real orgnrm; extern doublereal slanst_(char *, integer *, real *, real *); extern /* Subroutine */ int ssterf_(integer *, real *, real *, integer *); @@ -24083,7 +24083,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * CSTEDC computes all eigenvalues and, optionally, eigenvectors of a symmetric tridiagonal matrix using the divide and conquer method. - The eigenvectors of a full or band complex Hermitian matrix can also + The eigenvectors of a full or band singlecomplex Hermitian matrix can also be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this matrix to tridiagonal form. @@ -24491,7 +24491,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cstedc_ */ /* Subroutine */ int csteqr_(char *compz, integer *n, real *d__, real *e, - complex *z__, integer *ldz, real *work, integer *info) + singlecomplex *z__, integer *ldz, real *work, integer *info) { /* System generated locals */ integer z_dim1, z_offset, i__1, i__2; @@ -24510,18 +24510,18 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * ; extern logical lsame_(char *, char *); extern /* Subroutine */ int clasr_(char *, char *, char *, integer *, - integer *, real *, real *, complex *, integer *); + integer *, real *, real *, singlecomplex *, integer *); static real anorm; - extern /* Subroutine */ int cswap_(integer *, complex *, integer *, - complex *, integer *); + extern /* Subroutine */ int cswap_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *); static integer lendm1, lendp1; extern /* Subroutine */ int slaev2_(real *, real *, real *, real *, real * , real *, real *); extern doublereal slapy2_(real *, real *); static integer iscale; extern doublereal slamch_(char *); - extern /* Subroutine */ int claset_(char *, integer *, integer *, complex - *, complex *, complex *, integer *); + extern /* Subroutine */ int claset_(char *, integer *, integer *, singlecomplex + *, singlecomplex *, singlecomplex *, integer *); static real safmin; extern /* Subroutine */ int xerbla_(char *, integer *); static real safmax; @@ -24549,7 +24549,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * CSTEQR computes all eigenvalues and, optionally, eigenvectors of a symmetric tridiagonal matrix using the implicit QL or QR method. - The eigenvectors of a full or band complex Hermitian matrix can also + The eigenvectors of a full or band singlecomplex Hermitian matrix can also be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this matrix to tridiagonal form. @@ -25087,15 +25087,15 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* csteqr_ */ /* Subroutine */ int ctrevc_(char *side, char *howmny, logical *select, - integer *n, complex *t, integer *ldt, complex *vl, integer *ldvl, - complex *vr, integer *ldvr, integer *mm, integer *m, complex *work, + integer *n, singlecomplex *t, integer *ldt, singlecomplex *vl, integer *ldvl, + singlecomplex *vr, integer *ldvr, integer *mm, integer *m, singlecomplex *work, real *rwork, integer *info) { /* System generated locals */ integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3, i__4, i__5; real r__1, r__2, r__3; - complex q__1, q__2; + singlecomplex q__1, q__2; /* Local variables */ static integer i__, j, k, ii, ki, is; @@ -25105,21 +25105,21 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * static logical over; static real scale; extern logical lsame_(char *, char *); - extern /* Subroutine */ int cgemv_(char *, integer *, integer *, complex * - , complex *, integer *, complex *, integer *, complex *, complex * + extern /* Subroutine */ int cgemv_(char *, integer *, integer *, singlecomplex * + , singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * , integer *); static real remax; - extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, - complex *, integer *); + extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *); static logical leftv, bothv, somev; extern /* Subroutine */ int slabad_(real *, real *); - extern integer icamax_(integer *, complex *, integer *); + extern integer icamax_(integer *, singlecomplex *, integer *); extern doublereal slamch_(char *); - extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer + extern /* Subroutine */ int csscal_(integer *, real *, singlecomplex *, integer *), xerbla_(char *, integer *), clatrs_(char *, char *, - char *, char *, integer *, complex *, integer *, complex *, real * + char *, char *, integer *, singlecomplex *, integer *, singlecomplex *, real * , real *, integer *); - extern doublereal scasum_(integer *, complex *, integer *); + extern doublereal scasum_(integer *, singlecomplex *, integer *); static logical rightv; static real smlnum; @@ -25135,9 +25135,9 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * ======= CTREVC computes some or all of the right and/or left eigenvectors of - a complex upper triangular matrix T. + a singlecomplex upper triangular matrix T. Matrices of this type are produced by the Schur factorization of - a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. + a singlecomplex general matrix: A = Q*T*Q**H, as computed by CHSEQR. The right eigenvector x and the left eigenvector y of T corresponding to an eigenvalue w are defined by: @@ -25246,7 +25246,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * possible overflow. Each eigenvector is normalized so that the element of largest - magnitude has magnitude 1; here the magnitude of a complex number + magnitude has magnitude 1; here the magnitude of a singlecomplex number (x,y) is taken to be |x| + |y|. ===================================================================== @@ -25587,24 +25587,24 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* ctrevc_ */ -/* Subroutine */ int ctrexc_(char *compq, integer *n, complex *t, integer * - ldt, complex *q, integer *ldq, integer *ifst, integer *ilst, integer * +/* Subroutine */ int ctrexc_(char *compq, integer *n, singlecomplex *t, integer * + ldt, singlecomplex *q, integer *ldq, integer *ifst, integer *ilst, integer * info) { /* System generated locals */ integer q_dim1, q_offset, t_dim1, t_offset, i__1, i__2, i__3; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer k, m1, m2, m3; static real cs; - static complex t11, t22, sn, temp; - extern /* Subroutine */ int crot_(integer *, complex *, integer *, - complex *, integer *, real *, complex *); + static singlecomplex t11, t22, sn, temp; + extern /* Subroutine */ int crot_(integer *, singlecomplex *, integer *, + singlecomplex *, integer *, real *, singlecomplex *); extern logical lsame_(char *, char *); static logical wantq; - extern /* Subroutine */ int clartg_(complex *, complex *, real *, complex - *, complex *), xerbla_(char *, integer *); + extern /* Subroutine */ int clartg_(singlecomplex *, singlecomplex *, real *, singlecomplex + *, singlecomplex *), xerbla_(char *, integer *); /* @@ -25617,7 +25617,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CTREXC reorders the Schur factorization of a complex matrix + CTREXC reorders the Schur factorization of a singlecomplex matrix A = Q*T*Q**H, so that the diagonal element of T with row index IFST is moved to row ILST. @@ -25771,22 +25771,22 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* ctrexc_ */ -/* Subroutine */ int ctrti2_(char *uplo, char *diag, integer *n, complex *a, +/* Subroutine */ int ctrti2_(char *uplo, char *diag, integer *n, singlecomplex *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer j; - static complex ajj; - extern /* Subroutine */ int cscal_(integer *, complex *, complex *, + static singlecomplex ajj; + extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, integer *); extern logical lsame_(char *, char *); static logical upper; extern /* Subroutine */ int ctrmv_(char *, char *, char *, integer *, - complex *, integer *, complex *, integer *), xerbla_(char *, integer *); + singlecomplex *, integer *, singlecomplex *, integer *), xerbla_(char *, integer *); static logical nounit; @@ -25800,7 +25800,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CTRTI2 computes the inverse of a complex upper or lower triangular + CTRTI2 computes the inverse of a singlecomplex upper or lower triangular matrix. This is the Level 2 BLAS version of the algorithm. @@ -25935,25 +25935,25 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* ctrti2_ */ -/* Subroutine */ int ctrtri_(char *uplo, char *diag, integer *n, complex *a, +/* Subroutine */ int ctrtri_(char *uplo, char *diag, integer *n, singlecomplex *a, integer *lda, integer *info) { /* System generated locals */ address a__1[2]; integer a_dim1, a_offset, i__1, i__2, i__3[2], i__4, i__5; - complex q__1; + singlecomplex q__1; char ch__1[2]; /* Local variables */ static integer j, jb, nb, nn; extern logical lsame_(char *, char *); extern /* Subroutine */ int ctrmm_(char *, char *, char *, char *, - integer *, integer *, complex *, complex *, integer *, complex *, + integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *), ctrsm_(char *, char *, - char *, char *, integer *, integer *, complex *, complex *, - integer *, complex *, integer *); + char *, char *, integer *, integer *, singlecomplex *, singlecomplex *, + integer *, singlecomplex *, integer *); static logical upper; - extern /* Subroutine */ int ctrti2_(char *, char *, integer *, complex *, + extern /* Subroutine */ int ctrti2_(char *, char *, integer *, singlecomplex *, integer *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -25970,7 +25970,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CTRTRI computes the inverse of a complex upper or lower triangular + CTRTRI computes the inverse of a singlecomplex upper or lower triangular matrix A. This is the Level 3 BLAS version of the algorithm. @@ -26146,18 +26146,18 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* ctrtri_ */ -/* Subroutine */ int cung2r_(integer *m, integer *n, integer *k, complex *a, - integer *lda, complex *tau, complex *work, integer *info) +/* Subroutine */ int cung2r_(integer *m, integer *n, integer *k, singlecomplex *a, + integer *lda, singlecomplex *tau, singlecomplex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, j, l; - extern /* Subroutine */ int cscal_(integer *, complex *, complex *, - integer *), clarf_(char *, integer *, integer *, complex *, - integer *, complex *, complex *, integer *, complex *), + extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, + integer *), clarf_(char *, integer *, integer *, singlecomplex *, + integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), xerbla_(char *, integer *); @@ -26171,7 +26171,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNG2R generates an m by n complex matrix Q with orthonormal columns, + CUNG2R generates an m by n singlecomplex matrix Q with orthonormal columns, which is defined as the first n columns of a product of k elementary reflectors of order m @@ -26303,7 +26303,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cung2r_ */ /* Subroutine */ int cungbr_(char *vect, integer *m, integer *n, integer *k, - complex *a, integer *lda, complex *tau, complex *work, integer *lwork, + singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *work, integer *lwork, integer *info) { /* System generated locals */ @@ -26318,9 +26318,9 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int cunglq_(integer *, integer *, integer *, - complex *, integer *, complex *, complex *, integer *, integer *), - cungqr_(integer *, integer *, integer *, complex *, integer *, - complex *, complex *, integer *, integer *); + singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer *), + cungqr_(integer *, integer *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *, integer *); static integer lwkopt; static logical lquery; @@ -26335,8 +26335,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNGBR generates one of the complex unitary matrices Q or P**H - determined by CGEBRD when reducing a complex matrix A to bidiagonal + CUNGBR generates one of the singlecomplex unitary matrices Q or P**H + determined by CGEBRD when reducing a singlecomplex matrix A to bidiagonal form: A = Q * B * P**H. Q and P**H are defined as products of elementary reflectors H(i) or G(i) respectively. @@ -26590,8 +26590,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cungbr_ */ -/* Subroutine */ int cunghr_(integer *n, integer *ilo, integer *ihi, complex * - a, integer *lda, complex *tau, complex *work, integer *lwork, integer +/* Subroutine */ int cunghr_(integer *n, integer *ilo, integer *ihi, singlecomplex * + a, integer *lda, singlecomplex *tau, singlecomplex *work, integer *lwork, integer *info) { /* System generated locals */ @@ -26603,7 +26603,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int cungqr_(integer *, integer *, integer *, - complex *, integer *, complex *, complex *, integer *, integer *); + singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer *); static integer lwkopt; static logical lquery; @@ -26618,7 +26618,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNGHR generates a complex unitary matrix Q which is defined as the + CUNGHR generates a singlecomplex unitary matrix Q which is defined as the product of IHI-ILO elementary reflectors of order N, as returned by CGEHRD: @@ -26785,19 +26785,19 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cunghr_ */ -/* Subroutine */ int cungl2_(integer *m, integer *n, integer *k, complex *a, - integer *lda, complex *tau, complex *work, integer *info) +/* Subroutine */ int cungl2_(integer *m, integer *n, integer *k, singlecomplex *a, + integer *lda, singlecomplex *tau, singlecomplex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - complex q__1, q__2; + singlecomplex q__1, q__2; /* Local variables */ static integer i__, j, l; - extern /* Subroutine */ int cscal_(integer *, complex *, complex *, - integer *), clarf_(char *, integer *, integer *, complex *, - integer *, complex *, complex *, integer *, complex *), - clacgv_(integer *, complex *, integer *), xerbla_(char *, integer + extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, + integer *), clarf_(char *, integer *, integer *, singlecomplex *, + integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), + clacgv_(integer *, singlecomplex *, integer *), xerbla_(char *, integer *); @@ -26811,7 +26811,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNGL2 generates an m-by-n complex matrix Q with orthonormal rows, + CUNGL2 generates an m-by-n singlecomplex matrix Q with orthonormal rows, which is defined as the first m rows of a product of k elementary reflectors of order n @@ -26951,8 +26951,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cungl2_ */ -/* Subroutine */ int cunglq_(integer *m, integer *n, integer *k, complex *a, - integer *lda, complex *tau, complex *work, integer *lwork, integer * +/* Subroutine */ int cunglq_(integer *m, integer *n, integer *k, singlecomplex *a, + integer *lda, singlecomplex *tau, singlecomplex *work, integer *lwork, integer * info) { /* System generated locals */ @@ -26961,12 +26961,12 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * /* Local variables */ static integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ int cungl2_(integer *, integer *, integer *, - complex *, integer *, complex *, complex *, integer *), clarfb_( + singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, - complex *, integer *, complex *, integer *, complex *, integer *, - complex *, integer *), clarft_( - char *, char *, integer *, integer *, complex *, integer *, - complex *, complex *, integer *), xerbla_(char *, + singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, + singlecomplex *, integer *), clarft_( + char *, char *, integer *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -26984,7 +26984,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNGLQ generates an M-by-N complex matrix Q with orthonormal rows, + CUNGLQ generates an M-by-N singlecomplex matrix Q with orthonormal rows, which is defined as the first M rows of a product of K elementary reflectors of order N @@ -27212,8 +27212,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cunglq_ */ -/* Subroutine */ int cungqr_(integer *m, integer *n, integer *k, complex *a, - integer *lda, complex *tau, complex *work, integer *lwork, integer * +/* Subroutine */ int cungqr_(integer *m, integer *n, integer *k, singlecomplex *a, + integer *lda, singlecomplex *tau, singlecomplex *work, integer *lwork, integer * info) { /* System generated locals */ @@ -27222,12 +27222,12 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * /* Local variables */ static integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ int cung2r_(integer *, integer *, integer *, - complex *, integer *, complex *, complex *, integer *), clarfb_( + singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, - complex *, integer *, complex *, integer *, complex *, integer *, - complex *, integer *), clarft_( - char *, char *, integer *, integer *, complex *, integer *, - complex *, complex *, integer *), xerbla_(char *, + singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, + singlecomplex *, integer *), clarft_( + char *, char *, integer *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -27245,7 +27245,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNGQR generates an M-by-N complex matrix Q with orthonormal columns, + CUNGQR generates an M-by-N singlecomplex matrix Q with orthonormal columns, which is defined as the first N columns of a product of K elementary reflectors of order M @@ -27475,20 +27475,20 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cungqr_ */ /* Subroutine */ int cunm2l_(char *side, char *trans, integer *m, integer *n, - integer *k, complex *a, integer *lda, complex *tau, complex *c__, - integer *ldc, complex *work, integer *info) + integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, + integer *ldc, singlecomplex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, i1, i2, i3, mi, ni, nq; - static complex aii; + static singlecomplex aii; static logical left; - static complex taui; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * - , integer *, complex *, complex *, integer *, complex *); + static singlecomplex taui; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * + , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *); extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); static logical notran; @@ -27504,7 +27504,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNM2L overwrites the general complex m-by-n matrix C with + CUNM2L overwrites the general singlecomplex m-by-n matrix C with Q * C if SIDE = 'L' and TRANS = 'N', or @@ -27514,7 +27514,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * C * Q' if SIDE = 'R' and TRANS = 'C', - where Q is a complex unitary matrix defined as the product of k + where Q is a singlecomplex unitary matrix defined as the product of k elementary reflectors Q = H(k) . . . H(2) H(1) @@ -27687,20 +27687,20 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cunm2l_ */ /* Subroutine */ int cunm2r_(char *side, char *trans, integer *m, integer *n, - integer *k, complex *a, integer *lda, complex *tau, complex *c__, - integer *ldc, complex *work, integer *info) + integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, + integer *ldc, singlecomplex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, i1, i2, i3, ic, jc, mi, ni, nq; - static complex aii; + static singlecomplex aii; static logical left; - static complex taui; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * - , integer *, complex *, complex *, integer *, complex *); + static singlecomplex taui; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * + , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *); extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); static logical notran; @@ -27716,7 +27716,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNM2R overwrites the general complex m-by-n matrix C with + CUNM2R overwrites the general singlecomplex m-by-n matrix C with Q * C if SIDE = 'L' and TRANS = 'N', or @@ -27726,7 +27726,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * C * Q' if SIDE = 'R' and TRANS = 'C', - where Q is a complex unitary matrix defined as the product of k + where Q is a singlecomplex unitary matrix defined as the product of k elementary reflectors Q = H(1) H(2) . . . H(k) @@ -27903,8 +27903,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cunm2r_ */ /* Subroutine */ int cunmbr_(char *vect, char *side, char *trans, integer *m, - integer *n, integer *k, complex *a, integer *lda, complex *tau, - complex *c__, integer *ldc, complex *work, integer *lwork, integer * + integer *n, integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, + singlecomplex *c__, integer *ldc, singlecomplex *work, integer *lwork, integer * info) { /* System generated locals */ @@ -27921,12 +27921,12 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int cunmlq_(char *, char *, integer *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, - complex *, integer *, integer *); + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *, integer *); static logical notran; extern /* Subroutine */ int cunmqr_(char *, char *, integer *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, - complex *, integer *, integer *); + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *, integer *); static logical applyq; static char transt[1]; static integer lwkopt; @@ -27943,20 +27943,20 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - If VECT = 'Q', CUNMBR overwrites the general complex M-by-N matrix C + If VECT = 'Q', CUNMBR overwrites the general singlecomplex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C C * Q TRANS = 'C': Q**H * C C * Q**H - If VECT = 'P', CUNMBR overwrites the general complex M-by-N matrix C + If VECT = 'P', CUNMBR overwrites the general singlecomplex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': P * C C * P TRANS = 'C': P**H * C C * P**H Here Q and P**H are the unitary matrices determined by CGEBRD when - reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q + reducing a singlecomplex matrix A to bidiagonal form: A = Q * B * P**H. Q and P**H are defined as products of elementary reflectors H(i) and G(i) respectively. @@ -28243,8 +28243,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cunmbr_ */ /* Subroutine */ int cunmhr_(char *side, char *trans, integer *m, integer *n, - integer *ilo, integer *ihi, complex *a, integer *lda, complex *tau, - complex *c__, integer *ldc, complex *work, integer *lwork, integer * + integer *ilo, integer *ihi, singlecomplex *a, integer *lda, singlecomplex *tau, + singlecomplex *c__, integer *ldc, singlecomplex *work, integer *lwork, integer * info) { /* System generated locals */ @@ -28261,8 +28261,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int cunmqr_(char *, char *, integer *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, - complex *, integer *, integer *); + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *, integer *); static integer lwkopt; static logical lquery; @@ -28277,13 +28277,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNMHR overwrites the general complex M-by-N matrix C with + CUNMHR overwrites the general singlecomplex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C C * Q TRANS = 'C': Q**H * C C * Q**H - where Q is a complex unitary matrix of order nq, with nq = m if + where Q is a singlecomplex unitary matrix of order nq, with nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of IHI-ILO elementary reflectors, as returned by CGEHRD: @@ -28469,22 +28469,22 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cunmhr_ */ /* Subroutine */ int cunml2_(char *side, char *trans, integer *m, integer *n, - integer *k, complex *a, integer *lda, complex *tau, complex *c__, - integer *ldc, complex *work, integer *info) + integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, + integer *ldc, singlecomplex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3; - complex q__1; + singlecomplex q__1; /* Local variables */ static integer i__, i1, i2, i3, ic, jc, mi, ni, nq; - static complex aii; + static singlecomplex aii; static logical left; - static complex taui; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * - , integer *, complex *, complex *, integer *, complex *); + static singlecomplex taui; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * + , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *); extern logical lsame_(char *, char *); - extern /* Subroutine */ int clacgv_(integer *, complex *, integer *), + extern /* Subroutine */ int clacgv_(integer *, singlecomplex *, integer *), xerbla_(char *, integer *); static logical notran; @@ -28499,7 +28499,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNML2 overwrites the general complex m-by-n matrix C with + CUNML2 overwrites the general singlecomplex m-by-n matrix C with Q * C if SIDE = 'L' and TRANS = 'N', or @@ -28509,7 +28509,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * C * Q' if SIDE = 'R' and TRANS = 'C', - where Q is a complex unitary matrix defined as the product of k + where Q is a singlecomplex unitary matrix defined as the product of k elementary reflectors Q = H(k)' . . . H(2)' H(1)' @@ -28694,8 +28694,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cunml2_ */ /* Subroutine */ int cunmlq_(char *side, char *trans, integer *m, integer *n, - integer *k, complex *a, integer *lda, complex *tau, complex *c__, - integer *ldc, complex *work, integer *lwork, integer *info) + integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, + integer *ldc, singlecomplex *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; @@ -28705,18 +28705,18 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * /* Local variables */ static integer i__; - static complex t[4160] /* was [65][64] */; + static singlecomplex t[4160] /* was [65][64] */; static integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws; static logical left; extern logical lsame_(char *, char *); static integer nbmin, iinfo; extern /* Subroutine */ int cunml2_(char *, char *, integer *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, - complex *, integer *), clarfb_(char *, char *, - char *, char *, integer *, integer *, integer *, complex *, - integer *, complex *, integer *, complex *, integer *, complex *, + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *), clarfb_(char *, char *, + char *, char *, integer *, integer *, integer *, singlecomplex *, + integer *, singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, integer *), clarft_(char *, char * - , integer *, integer *, complex *, integer *, complex *, complex * + , integer *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * , integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -28737,13 +28737,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNMLQ overwrites the general complex M-by-N matrix C with + CUNMLQ overwrites the general singlecomplex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C C * Q TRANS = 'C': Q**H * C C * Q**H - where Q is a complex unitary matrix defined as the product of k + where Q is a singlecomplex unitary matrix defined as the product of k elementary reflectors Q = H(k)' . . . H(2)' H(1)' @@ -28999,8 +28999,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cunmlq_ */ /* Subroutine */ int cunmql_(char *side, char *trans, integer *m, integer *n, - integer *k, complex *a, integer *lda, complex *tau, complex *c__, - integer *ldc, complex *work, integer *lwork, integer *info) + integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, + integer *ldc, singlecomplex *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; @@ -29010,18 +29010,18 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * /* Local variables */ static integer i__; - static complex t[4160] /* was [65][64] */; + static singlecomplex t[4160] /* was [65][64] */; static integer i1, i2, i3, ib, nb, mi, ni, nq, nw, iws; static logical left; extern logical lsame_(char *, char *); static integer nbmin, iinfo; extern /* Subroutine */ int cunm2l_(char *, char *, integer *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, - complex *, integer *), clarfb_(char *, char *, - char *, char *, integer *, integer *, integer *, complex *, - integer *, complex *, integer *, complex *, integer *, complex *, + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *), clarfb_(char *, char *, + char *, char *, integer *, integer *, integer *, singlecomplex *, + integer *, singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, integer *), clarft_(char *, char * - , integer *, integer *, complex *, integer *, complex *, complex * + , integer *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * , integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -29040,13 +29040,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNMQL overwrites the general complex M-by-N matrix C with + CUNMQL overwrites the general singlecomplex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C C * Q TRANS = 'C': Q**H * C C * Q**H - where Q is a complex unitary matrix defined as the product of k + where Q is a singlecomplex unitary matrix defined as the product of k elementary reflectors Q = H(k) . . . H(2) H(1) @@ -29297,8 +29297,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cunmql_ */ /* Subroutine */ int cunmqr_(char *side, char *trans, integer *m, integer *n, - integer *k, complex *a, integer *lda, complex *tau, complex *c__, - integer *ldc, complex *work, integer *lwork, integer *info) + integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, + integer *ldc, singlecomplex *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; @@ -29308,18 +29308,18 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * /* Local variables */ static integer i__; - static complex t[4160] /* was [65][64] */; + static singlecomplex t[4160] /* was [65][64] */; static integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws; static logical left; extern logical lsame_(char *, char *); static integer nbmin, iinfo; extern /* Subroutine */ int cunm2r_(char *, char *, integer *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, - complex *, integer *), clarfb_(char *, char *, - char *, char *, integer *, integer *, integer *, complex *, - integer *, complex *, integer *, complex *, integer *, complex *, + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *), clarfb_(char *, char *, + char *, char *, integer *, integer *, integer *, singlecomplex *, + integer *, singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, integer *), clarft_(char *, char * - , integer *, integer *, complex *, integer *, complex *, complex * + , integer *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * , integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -29338,13 +29338,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNMQR overwrites the general complex M-by-N matrix C with + CUNMQR overwrites the general singlecomplex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C C * Q TRANS = 'C': Q**H * C C * Q**H - where Q is a complex unitary matrix defined as the product of k + where Q is a singlecomplex unitary matrix defined as the product of k elementary reflectors Q = H(1) H(2) . . . H(k) @@ -29595,8 +29595,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * } /* cunmqr_ */ /* Subroutine */ int cunmtr_(char *side, char *uplo, char *trans, integer *m, - integer *n, complex *a, integer *lda, complex *tau, complex *c__, - integer *ldc, complex *work, integer *lwork, integer *info) + integer *n, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, + integer *ldc, singlecomplex *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; @@ -29613,10 +29613,10 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int cunmql_(char *, char *, integer *, integer *, - integer *, complex *, integer *, complex *, complex *, integer *, - complex *, integer *, integer *), cunmqr_(char *, - char *, integer *, integer *, integer *, complex *, integer *, - complex *, complex *, integer *, complex *, integer *, integer *); + integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + singlecomplex *, integer *, integer *), cunmqr_(char *, + char *, integer *, integer *, integer *, singlecomplex *, integer *, + singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, integer *); static integer lwkopt; static logical lquery; @@ -29631,13 +29631,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * Purpose ======= - CUNMTR overwrites the general complex M-by-N matrix C with + CUNMTR overwrites the general singlecomplex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C C * Q TRANS = 'C': Q**H * C C * Q**H - where Q is a complex unitary matrix of order nq, with nq = m if + where Q is a singlecomplex unitary matrix of order nq, with nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of nq-1 elementary reflectors, as returned by CHETRD: diff --git a/numpy/linalg/lapack_lite/f2c_lapack.c b/numpy/linalg/lapack_lite/f2c_lapack.c index 752261044bf8..47540b37edc0 100644 --- a/numpy/linalg/lapack_lite/f2c_lapack.c +++ b/numpy/linalg/lapack_lite/f2c_lapack.c @@ -183,7 +183,7 @@ integer ieeeck_(integer *ispec, real *zero, real *one) return ret_val; } /* ieeeck_ */ -integer ilaclc_(integer *m, integer *n, complex *a, integer *lda) +integer ilaclc_(integer *m, integer *n, singlecomplex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, ret_val, i__1, i__2; @@ -256,7 +256,7 @@ integer ilaclc_(integer *m, integer *n, complex *a, integer *lda) return ret_val; } /* ilaclc_ */ -integer ilaclr_(integer *m, integer *n, complex *a, integer *lda) +integer ilaclr_(integer *m, integer *n, singlecomplex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, ret_val, i__1, i__2; From 5c38f350dd27ccc4e52d27898a5ecc01178b12b8 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Thu, 29 Jun 2023 13:55:08 +0200 Subject: [PATCH 05/40] Fix complex init --- numpy/core/src/umath/matmul.c.src | 4 ++-- numpy/linalg/umath_linalg.cpp | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/numpy/core/src/umath/matmul.c.src b/numpy/core/src/umath/matmul.c.src index 35a64658a241..ebaeef92a0fb 100644 --- a/numpy/core/src/umath/matmul.c.src +++ b/numpy/core/src/umath/matmul.c.src @@ -62,8 +62,8 @@ is_blasable2d(npy_intp byte_stride1, npy_intp byte_stride2, return NPY_FALSE; } -static const npy_cdouble oneD = {1.0, 0.0}, zeroD = {0.0, 0.0}; -static const npy_cfloat oneF = {1.0, 0.0}, zeroF = {0.0, 0.0}; +static const npy_cdouble oneD = 1.0, zeroD = 0.0; +static const npy_cfloat oneF = 1.0f, zeroF = 0.0f; /**begin repeat * diff --git a/numpy/linalg/umath_linalg.cpp b/numpy/linalg/umath_linalg.cpp index 530e0ba02b9b..481a6c8617a6 100644 --- a/numpy/linalg/umath_linalg.cpp +++ b/numpy/linalg/umath_linalg.cpp @@ -471,9 +471,9 @@ const double numeric_limits::nan = NPY_NAN; template<> struct numeric_limits { -static constexpr npy_cfloat one = {1.0f, 0.0f}; -static constexpr npy_cfloat zero = {0.0f, 0.0f}; -static constexpr npy_cfloat minus_one = {-1.0f, 0.0f}; +static constexpr npy_cfloat one = 1.0f; +static constexpr npy_cfloat zero = 0.0f; +static constexpr npy_cfloat minus_one = -1.0f; static const npy_cfloat ninf; static const npy_cfloat nan; }; @@ -499,9 +499,9 @@ const f2c_complex numeric_limits::nan = {NPY_NANF, NPY_NANF}; template<> struct numeric_limits { -static constexpr npy_cdouble one = {1.0, 0.0}; -static constexpr npy_cdouble zero = {0.0, 0.0}; -static constexpr npy_cdouble minus_one = {-1.0, 0.0}; +static constexpr npy_cdouble one = 1.0; +static constexpr npy_cdouble zero = 0.0; +static constexpr npy_cdouble minus_one = -1.0; static const npy_cdouble ninf; static const npy_cdouble nan; }; From b240b10371b1bffaac90db9e703db9c2e0167682 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Thu, 29 Jun 2023 14:00:07 +0200 Subject: [PATCH 06/40] Fix uninitialized values in arraytypes --- numpy/core/src/multiarray/arraytypes.c.src | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/numpy/core/src/multiarray/arraytypes.c.src b/numpy/core/src/multiarray/arraytypes.c.src index 1c157aadcdf6..1b3b23af6855 100644 --- a/numpy/core/src/multiarray/arraytypes.c.src +++ b/numpy/core/src/multiarray/arraytypes.c.src @@ -3981,15 +3981,9 @@ static int @NAME@_fill(@type@ *buffer, npy_intp length, void *NPY_UNUSED(ignore)) { npy_intp i; - @type@ start; - @type@ delta; - - NPY_@NAME@_GET_REAL(&start) = NPY_@NAME@_GET_REAL(buffer); - NPY_@NAME@_GET_IMAG(&start) = NPY_@NAME@_GET_IMAG(buffer); - NPY_@NAME@_GET_REAL(&delta) = NPY_@NAME@_GET_REAL(&buffer[1]); - NPY_@NAME@_GET_IMAG(&delta) = NPY_@NAME@_GET_IMAG(&buffer[1]); - NPY_@NAME@_GET_REAL(&delta) -= NPY_@NAME@_GET_REAL(&start); - NPY_@NAME@_GET_IMAG(&delta) -= NPY_@NAME@_GET_IMAG(&start); + @type@ start = buffer[0]; + @type@ delta = buffer[1] - start; + buffer += 2; for (i = 2; i < length; i++, buffer++) { NPY_@NAME@_GET_REAL(buffer) = NPY_@NAME@_GET_REAL(&start) + i*NPY_@NAME@_GET_REAL(&delta); From 725a8d6e53f9aa56344c5ec907e6d1c63d2d6220 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 30 Jun 2023 11:26:08 +0200 Subject: [PATCH 07/40] Make GET_REAL and GET_IMAG into inline functions that use unions --- numpy/core/include/numpy/ndarraytypes.h | 24 ++- numpy/core/include/numpy/npy_common.h | 148 +++++++++++++++++- numpy/core/include/numpy/npy_math.h | 12 +- numpy/core/src/common/cblasfuncs.c | 16 +- numpy/core/src/multiarray/arraytypes.c.src | 36 ++--- numpy/core/src/multiarray/compiled_base.c | 32 ++-- numpy/core/src/multiarray/scalarapi.c | 4 +- .../src/multiarray/textreading/conversions.c | 8 +- numpy/core/src/umath/funcs.inc.src | 30 ++-- numpy/core/src/umath/loops.c.src | 12 +- numpy/core/src/umath/matmul.c.src | 13 +- numpy/core/src/umath/scalarmath.c.src | 28 ++-- 12 files changed, 253 insertions(+), 110 deletions(-) diff --git a/numpy/core/include/numpy/ndarraytypes.h b/numpy/core/include/numpy/ndarraytypes.h index 00cbac1bcbe7..a95c7cf2f4a1 100644 --- a/numpy/core/include/numpy/ndarraytypes.h +++ b/numpy/core/include/numpy/ndarraytypes.h @@ -962,6 +962,23 @@ typedef int (PyArray_FinalizeFunc)(PyArrayObject *, PyObject *); #define PyArray_MAX(a,b) (((a)>(b))?(a):(b)) #define PyArray_MIN(a,b) (((a)<(b))?(a):(b)) + +#ifdef __cplusplus +#define PyArray_CLT(p,q, type) (p).real() == (q).real() \ + ? (p).imag() < (q).imag() \ + : (p).real() < (q).real() +#define PyArray_CGT(p,q, type) (p).real() == (q).real() \ + ? (p).imag() > (q).imag() \ + : (p).real() > (q).real() +#define PyArray_CLE(p,q, type) (p).real() == (q).real() \ + ? (p).imag() <= (q).imag() \ + : (p).real() <= (q).real() +#define PyArray_CGE(p,q, type) (p).real() == (q).real() \ + ? (p).imag() >= (q).imag() \ + : (p).real() >= (q).real() +#define PyArray_CEQ(p,q, type) (p) == (q) +#define PyArray_CNE(p,q, type) (p) != (q) +#else #define PyArray_CLT(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ ? NPY_##type##_GET_IMAG(&(p)) < NPY_##type##_GET_IMAG(&(q)) \ : NPY_##type##_GET_REAL(&(p)) < NPY_##type##_GET_REAL(&(q)) @@ -974,10 +991,9 @@ typedef int (PyArray_FinalizeFunc)(PyArrayObject *, PyObject *); #define PyArray_CGE(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ ? NPY_##type##_GET_IMAG(&(p)) >= NPY_##type##_GET_IMAG(&(q)) \ : NPY_##type##_GET_REAL(&(p)) >= NPY_##type##_GET_REAL(&(q)) -#define PyArray_CEQ(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ - && NPY_##type##_GET_IMAG(&(p)) == NPY_##type##_GET_IMAG(&(q)) -#define PyArray_CNE(p,q, type) NPY_##type##_GET_REAL(&(p)) != NPY_##type##_GET_REAL(&(q)) \ - || NPY_##type##_GET_IMAG(&(p)) != NPY_##type##_GET_IMAG(&(q)) +#define PyArray_CEQ(p,q, type) (p) == (q) +#define PyArray_CNE(p,q, type) (p) != (q) +#endif /* * C API: consists of Macros and functions. The MACROS are defined diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index 23c5c3d643e9..b0326fbf3802 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -402,12 +402,148 @@ typedef complex float npy_cfloat; typedef complex longdouble_t npy_clongdouble; #endif -#define NPY_CDOUBLE_GET_REAL(comp) ( *((double *) (comp)) ) -#define NPY_CDOUBLE_GET_IMAG(comp) ( *(((double *) (comp)) + 1) ) -#define NPY_CFLOAT_GET_REAL(comp) ( *((float *) (comp)) ) -#define NPY_CFLOAT_GET_IMAG(comp) ( *(((float *) (comp)) + 1) ) -#define NPY_CLONGDOUBLE_GET_REAL(comp) ( *((npy_longdouble *) (comp)) ) -#define NPY_CLONGDOUBLE_GET_IMAG(comp) ( *(((npy_longdouble *) (comp)) + 1) ) +#ifndef __cplusplus +typedef union { + double arr[2]; + npy_cdouble comp; +} _npy_cdouble_to_arr; + +typedef union { + float arr[2]; + npy_cfloat comp; +} _npy_cfloat_to_arr; + +typedef union { + longdouble_t arr[2]; + npy_clongdouble comp; +} _npy_clongdouble_to_arr; +#endif + +inline double NPY_CDOUBLE_GET_REAL(const npy_cdouble *c) { +#ifdef __cplusplus + return reinterpret_cast(c)[0]; +#else + _npy_cdouble_to_arr tmp; + tmp.comp = *c; + return tmp.arr[0]; +#endif +} + +inline double NPY_CDOUBLE_GET_IMAG(const npy_cdouble *c) { +#ifdef __cplusplus + return reinterpret_cast(c)[1]; +#else + _npy_cdouble_to_arr tmp; + tmp.comp = *c; + return tmp.arr[1]; +#endif +} + +inline void NPY_CDOUBLE_SET_REAL(npy_cdouble *c, double real) { +#ifdef __cplusplus + double *tmp = reinterpret_cast(c); + tmp[0] = real; +#else + _npy_cdouble_to_arr tmp; + tmp.arr[0] = real; + *c = tmp.comp; +#endif +} + +inline void NPY_CDOUBLE_SET_IMAG(npy_cdouble *c, double imag) { +#ifdef __cplusplus + double *tmp = reinterpret_cast(c); + tmp[1] = imag; +#else + _npy_cdouble_to_arr tmp; + tmp.arr[1] = imag; + *c = tmp.comp; +#endif +} + +inline float NPY_CFLOAT_GET_REAL(const npy_cfloat *c) { +#ifdef __cplusplus + return reinterpret_cast(c)[0]; +#else + _npy_cfloat_to_arr tmp; + tmp.comp = *c; + return tmp.arr[0]; +#endif +} + +inline float NPY_CFLOAT_GET_IMAG(const npy_cfloat *c) { +#ifdef __cplusplus + return reinterpret_cast(c)[1]; +#else + _npy_cdouble_to_arr tmp; + tmp.comp = *c; + return tmp.arr[1]; +#endif +} + +inline void NPY_CFLOAT_SET_REAL(npy_cfloat *c, float real) { +#ifdef __cplusplus + float *tmp = reinterpret_cast(c); + tmp[0] = real; +#else + _npy_cfloat_to_arr tmp; + tmp.arr[0] = real; + *c = tmp.comp; +#endif +} + +inline void NPY_CFLOAT_SET_IMAG(npy_cfloat *c, float imag) { +#ifdef __cplusplus + float *tmp = reinterpret_cast(c); + tmp[1] = imag; +#else + _npy_cfloat_to_arr tmp; + tmp.arr[1] = imag; + *c = tmp.comp; +#endif +} + +inline longdouble_t NPY_CLONGDOUBLE_GET_REAL(const npy_clongdouble *c) { +#ifdef __cplusplus + return reinterpret_cast(c)[0]; +#else + _npy_clongdouble_to_arr tmp; + tmp.comp = *c; + return tmp.arr[0]; +#endif +} + +inline longdouble_t NPY_CLONGDOUBLE_GET_IMAG(const npy_clongdouble *c) { +#ifdef __cplusplus + return reinterpret_cast(c)[1]; +#else + _npy_clongdouble_to_arr tmp; + tmp.comp = *c; + return tmp.arr[1]; +#endif +} + +inline void NPY_CLONGDOUBLE_SET_REAL(npy_clongdouble *c, longdouble_t real) { +#ifdef __cplusplus + longdouble_t *tmp = reinterpret_cast(c); + tmp[0] = real; +#else + _npy_clongdouble_to_arr tmp; + tmp.arr[0] = real; + *c = tmp.comp; +#endif +} + +inline void NPY_CLONGDOUBLE_SET_IMAG(npy_clongdouble *c, longdouble_t imag) { +#ifdef __cplusplus + longdouble_t *tmp = reinterpret_cast(c); + tmp[1] = imag; +#else + _npy_clongdouble_to_arr tmp; + tmp.arr[1] = imag; + *c = tmp.comp; +#endif +} /* * numarray-style bit-width typedefs diff --git a/numpy/core/include/numpy/npy_math.h b/numpy/core/include/numpy/npy_math.h index bd1f88b0fb28..066c3d3e609a 100644 --- a/numpy/core/include/numpy/npy_math.h +++ b/numpy/core/include/numpy/npy_math.h @@ -360,24 +360,24 @@ NPY_INPLACE npy_longdouble npy_heavisidel(npy_longdouble x, npy_longdouble h0); static inline npy_cdouble npy_cpack(double x, double y) { npy_cdouble z; - NPY_CDOUBLE_GET_REAL(&z) = x; - NPY_CDOUBLE_GET_IMAG(&z) = y; + NPY_CDOUBLE_SET_REAL(&z, x); + NPY_CDOUBLE_SET_IMAG(&z, y); return z; } static inline npy_cfloat npy_cpackf(float x, float y) { npy_cfloat z; - NPY_CFLOAT_GET_REAL(&z) = x; - NPY_CFLOAT_GET_IMAG(&z) = y; + NPY_CFLOAT_SET_REAL(&z, x); + NPY_CFLOAT_SET_IMAG(&z, y); return z; } static inline npy_clongdouble npy_cpackl(npy_longdouble x, npy_longdouble y) { npy_clongdouble z; - NPY_CLONGDOUBLE_GET_REAL(&z) = x; - NPY_CLONGDOUBLE_GET_IMAG(&z) = y; + NPY_CLONGDOUBLE_SET_REAL(&z, x); + NPY_CLONGDOUBLE_SET_IMAG(&z, y); return z; } diff --git a/numpy/core/src/common/cblasfuncs.c b/numpy/core/src/common/cblasfuncs.c index aa1d1a5b26c3..1bce66ef921f 100644 --- a/numpy/core/src/common/cblasfuncs.c +++ b/numpy/core/src/common/cblasfuncs.c @@ -422,10 +422,10 @@ cblas_matrixproduct(int typenum, PyArrayObject *ap1, PyArrayObject *ap2, ptr1 = (npy_cdouble *)PyArray_DATA(ap2); ptr2 = (npy_cdouble *)PyArray_DATA(ap1); res = (npy_cdouble *)PyArray_DATA(out_buf); - NPY_CDOUBLE_GET_REAL(res) = NPY_CDOUBLE_GET_REAL(ptr1) * NPY_CDOUBLE_GET_REAL(ptr2) - - NPY_CDOUBLE_GET_IMAG(ptr1) * NPY_CDOUBLE_GET_IMAG(ptr2); - NPY_CDOUBLE_GET_IMAG(res) = NPY_CDOUBLE_GET_REAL(ptr1) * NPY_CDOUBLE_GET_IMAG(ptr2) - + NPY_CDOUBLE_GET_IMAG(ptr1) * NPY_CDOUBLE_GET_REAL(ptr2); + NPY_CDOUBLE_SET_REAL(res, NPY_CDOUBLE_GET_REAL(ptr1) * NPY_CDOUBLE_GET_REAL(ptr2) + - NPY_CDOUBLE_GET_IMAG(ptr1) * NPY_CDOUBLE_GET_IMAG(ptr2)); + NPY_CDOUBLE_SET_IMAG(res, NPY_CDOUBLE_GET_REAL(ptr1) * NPY_CDOUBLE_GET_IMAG(ptr2) + + NPY_CDOUBLE_GET_IMAG(ptr1) * NPY_CDOUBLE_GET_REAL(ptr2)); } else if (ap1shape != _matrix) { CBLAS_FUNC(cblas_zaxpy)(l, @@ -497,10 +497,10 @@ cblas_matrixproduct(int typenum, PyArrayObject *ap1, PyArrayObject *ap2, ptr1 = (npy_cfloat *)PyArray_DATA(ap2); ptr2 = (npy_cfloat *)PyArray_DATA(ap1); res = (npy_cfloat *)PyArray_DATA(out_buf); - NPY_CFLOAT_GET_REAL(res) = NPY_CFLOAT_GET_REAL(ptr1) * NPY_CFLOAT_GET_REAL(ptr2) - - NPY_CFLOAT_GET_IMAG(ptr1) * NPY_CFLOAT_GET_IMAG(ptr2); - NPY_CFLOAT_GET_IMAG(res) = NPY_CFLOAT_GET_REAL(ptr1) * NPY_CFLOAT_GET_IMAG(ptr2) - + NPY_CFLOAT_GET_IMAG(ptr1) * NPY_CFLOAT_GET_REAL(ptr2); + NPY_CFLOAT_SET_REAL(res, NPY_CFLOAT_GET_REAL(ptr1) * NPY_CFLOAT_GET_REAL(ptr2) + - NPY_CFLOAT_GET_IMAG(ptr1) * NPY_CFLOAT_GET_IMAG(ptr2)); + NPY_CFLOAT_SET_IMAG(res, NPY_CFLOAT_GET_REAL(ptr1) * NPY_CFLOAT_GET_IMAG(ptr2) + + NPY_CFLOAT_GET_IMAG(ptr1) * NPY_CFLOAT_GET_REAL(ptr2)); } else if (ap1shape != _matrix) { CBLAS_FUNC(cblas_caxpy)(l, diff --git a/numpy/core/src/multiarray/arraytypes.c.src b/numpy/core/src/multiarray/arraytypes.c.src index 1b3b23af6855..07399b1681a1 100644 --- a/numpy/core/src/multiarray/arraytypes.c.src +++ b/numpy/core/src/multiarray/arraytypes.c.src @@ -501,8 +501,8 @@ NPY_NO_EXPORT int return -1; } } - NPY_@NAME@_GET_REAL(&temp) = (@ftype@) oop.real; - NPY_@NAME@_GET_IMAG(&temp) = (@ftype@) oop.imag; + NPY_@NAME@_SET_REAL(&temp, (@ftype@) oop.real); + NPY_@NAME@_SET_IMAG(&temp, (@ftype@) oop.imag); #if NPY_SIZEOF_@NAME@ < NPY_SIZEOF_CDOUBLE /* really just float... */ /* Overflow could have occurred converting double to float */ @@ -1948,7 +1948,7 @@ static int char next = getc(fp); if ((next == '+') || (next == '-')) { // Imaginary component specified - NPY_@fname@_GET_REAL(&output) = result; + NPY_@fname@_SET_REAL(&output, result); // Revert peek and read imaginary component ungetc(next, fp); ret_imag = NumPyOS_ascii_ftolf(fp, &result); @@ -1956,23 +1956,23 @@ static int next = getc(fp); if ((ret_imag == 1) && (next == 'j')) { // If read is successful and the immediate following char is j - NPY_@fname@_GET_IMAG(&output) = result; + NPY_@fname@_SET_IMAG(&output, result); } else { - NPY_@fname@_GET_IMAG(&output) = 0; + NPY_@fname@_SET_IMAG(&output, 0); // Push an invalid char to trigger the not everything is read error ungetc('a', fp); } } else if (next == 'j') { // Real component not specified - NPY_@fname@_GET_REAL(&output) = 0; - NPY_@fname@_GET_IMAG(&output) = result; + NPY_@fname@_SET_REAL(&output, 0); + NPY_@fname@_SET_IMAG(&output, result); } else { // Imaginary component not specified - NPY_@fname@_GET_REAL(&output) = result; - NPY_@fname@_GET_IMAG(&output) = 0.; + NPY_@fname@_SET_REAL(&output, result); + NPY_@fname@_SET_IMAG(&output, 0.); // Next character is not + / - / j. Revert peek. ungetc(next, fp); } @@ -2089,14 +2089,14 @@ static int if (endptr && ((*endptr[0] == '+') || (*endptr[0] == '-'))) { // Imaginary component specified - NPY_@fname@_GET_REAL(&output) = result; + NPY_@fname@_SET_REAL(&output, result); // Reading imaginary component char **prev = endptr; str = *endptr; result = NumPyOS_ascii_strtod(str, endptr); if (endptr && *endptr[0] == 'j') { // Read is successful if the immediate following char is j - NPY_@fname@_GET_IMAG(&output) = result; + NPY_@fname@_SET_IMAG(&output, result); // Skip j ++*endptr; } @@ -2106,20 +2106,20 @@ static int * read error */ endptr = prev; - NPY_@fname@_GET_IMAG(&output) = 0; + NPY_@fname@_SET_IMAG(&output, 0); } } else if (endptr && *endptr[0] == 'j') { // Real component not specified - NPY_@fname@_GET_REAL(&output) = 0; - NPY_@fname@_GET_IMAG(&output) = result; + NPY_@fname@_SET_REAL(&output, 0); + NPY_@fname@_SET_IMAG(&output, result); // Skip j ++*endptr; } else { // Imaginary component not specified - NPY_@fname@_GET_REAL(&output) = result; - NPY_@fname@_GET_IMAG(&output) = 0.; + NPY_@fname@_SET_REAL(&output, result); + NPY_@fname@_SET_IMAG(&output, 0.); } *(@type@ *)ip = output; return 0; @@ -3986,8 +3986,8 @@ static int buffer += 2; for (i = 2; i < length; i++, buffer++) { - NPY_@NAME@_GET_REAL(buffer) = NPY_@NAME@_GET_REAL(&start) + i*NPY_@NAME@_GET_REAL(&delta); - NPY_@NAME@_GET_IMAG(buffer) = NPY_@NAME@_GET_IMAG(&start) + i*NPY_@NAME@_GET_IMAG(&delta); + NPY_@NAME@_SET_REAL(buffer, NPY_@NAME@_GET_REAL(&start) + i*NPY_@NAME@_GET_REAL(&delta)); + NPY_@NAME@_SET_IMAG(buffer, NPY_@NAME@_GET_IMAG(&start) + i*NPY_@NAME@_GET_IMAG(&delta)); } return 0; } diff --git a/numpy/core/src/multiarray/compiled_base.c b/numpy/core/src/multiarray/compiled_base.c index b67c81b0cc64..656184fd522c 100644 --- a/numpy/core/src/multiarray/compiled_base.c +++ b/numpy/core/src/multiarray/compiled_base.c @@ -734,11 +734,11 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t lval = dy[0]; } else { - NPY_CDOUBLE_GET_REAL(&lval) = PyComplex_RealAsDouble(left); + NPY_CDOUBLE_SET_REAL(&lval, PyComplex_RealAsDouble(left)); if (error_converting(NPY_CDOUBLE_GET_REAL(&lval))) { goto fail; } - NPY_CDOUBLE_GET_IMAG(&lval) = PyComplex_ImagAsDouble(left); + NPY_CDOUBLE_SET_IMAG(&lval, PyComplex_ImagAsDouble(left)); if (error_converting(NPY_CDOUBLE_GET_IMAG(&lval))) { goto fail; } @@ -748,11 +748,11 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t rval = dy[lenxp - 1]; } else { - NPY_CDOUBLE_GET_REAL(&rval) = PyComplex_RealAsDouble(right); + NPY_CDOUBLE_SET_REAL(&rval, PyComplex_RealAsDouble(right)); if (error_converting(NPY_CDOUBLE_GET_REAL(&rval))) { goto fail; } - NPY_CDOUBLE_GET_IMAG(&rval) = PyComplex_ImagAsDouble(right); + NPY_CDOUBLE_SET_IMAG(&rval, PyComplex_ImagAsDouble(right)); if (error_converting(NPY_CDOUBLE_GET_IMAG(&rval))) { goto fail; } @@ -788,8 +788,8 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t if (slopes != NULL) { for (i = 0; i < lenxp - 1; ++i) { const double inv_dx = 1.0 / (dx[i+1] - dx[i]); - NPY_CDOUBLE_GET_REAL(&slopes[i]) = (NPY_CDOUBLE_GET_REAL(&dy[i+1]) - NPY_CDOUBLE_GET_REAL(&dy[i])) * inv_dx; - NPY_CDOUBLE_GET_IMAG(&slopes[i]) = (NPY_CDOUBLE_GET_IMAG(&dy[i+1]) - NPY_CDOUBLE_GET_IMAG(&dy[i])) * inv_dx; + NPY_CDOUBLE_SET_REAL(&slopes[i], (NPY_CDOUBLE_GET_REAL(&dy[i+1]) - NPY_CDOUBLE_GET_REAL(&dy[i])) * inv_dx); + NPY_CDOUBLE_SET_IMAG(&slopes[i], (NPY_CDOUBLE_GET_IMAG(&dy[i+1]) - NPY_CDOUBLE_GET_IMAG(&dy[i])) * inv_dx); } } @@ -797,8 +797,8 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t const npy_double x_val = dz[i]; if (npy_isnan(x_val)) { - NPY_CDOUBLE_GET_REAL(&dres[i]) = x_val; - NPY_CDOUBLE_GET_IMAG(&dres[i]) = 0.0; + NPY_CDOUBLE_SET_REAL(&dres[i], x_val); + NPY_CDOUBLE_SET_IMAG(&dres[i], 0.0); continue; } @@ -823,25 +823,25 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t } else { const npy_double inv_dx = 1.0 / (dx[j+1] - dx[j]); - NPY_CDOUBLE_GET_REAL(&slope) = (NPY_CDOUBLE_GET_REAL(&dy[j+1]) - NPY_CDOUBLE_GET_REAL(&dy[j])) * inv_dx; - NPY_CDOUBLE_GET_IMAG(&slope) = (NPY_CDOUBLE_GET_IMAG(&dy[j+1]) - NPY_CDOUBLE_GET_IMAG(&dy[j])) * inv_dx; + NPY_CDOUBLE_SET_REAL(&slope, (NPY_CDOUBLE_GET_REAL(&dy[j+1]) - NPY_CDOUBLE_GET_REAL(&dy[j])) * inv_dx); + NPY_CDOUBLE_SET_IMAG(&slope, (NPY_CDOUBLE_GET_IMAG(&dy[j+1]) - NPY_CDOUBLE_GET_IMAG(&dy[j])) * inv_dx); } /* If we get nan in one direction, try the other */ - NPY_CDOUBLE_GET_REAL(&dres[i]) = NPY_CDOUBLE_GET_REAL(&slope)*(x_val - dx[j]) + NPY_CDOUBLE_GET_REAL(&dy[j]); + NPY_CDOUBLE_SET_REAL(&dres[i], NPY_CDOUBLE_GET_REAL(&slope)*(x_val - dx[j]) + NPY_CDOUBLE_GET_REAL(&dy[j])); if (NPY_UNLIKELY(npy_isnan(NPY_CDOUBLE_GET_REAL(&dres[i])))) { - NPY_CDOUBLE_GET_REAL(&dres[i]) = NPY_CDOUBLE_GET_REAL(&slope)*(x_val - dx[j+1]) + NPY_CDOUBLE_GET_REAL(&dy[j+1]); + NPY_CDOUBLE_SET_REAL(&dres[i], NPY_CDOUBLE_GET_REAL(&slope)*(x_val - dx[j+1]) + NPY_CDOUBLE_GET_REAL(&dy[j+1])); if (NPY_UNLIKELY(npy_isnan(NPY_CDOUBLE_GET_REAL(&dres[i]))) && NPY_CDOUBLE_GET_REAL(&dy[j]) == NPY_CDOUBLE_GET_REAL(&dy[j+1])) { - NPY_CDOUBLE_GET_REAL(&dres[i]) = NPY_CDOUBLE_GET_REAL(&dy[j]); + NPY_CDOUBLE_SET_REAL(&dres[i], NPY_CDOUBLE_GET_REAL(&dy[j])); } } - NPY_CDOUBLE_GET_IMAG(&dres[i]) = NPY_CDOUBLE_GET_IMAG(&slope)*(x_val - dx[j]) + NPY_CDOUBLE_GET_IMAG(&dy[j]); + NPY_CDOUBLE_SET_IMAG(&dres[i], NPY_CDOUBLE_GET_IMAG(&slope)*(x_val - dx[j]) + NPY_CDOUBLE_GET_IMAG(&dy[j])); if (NPY_UNLIKELY(npy_isnan(NPY_CDOUBLE_GET_IMAG(&dres[i])))) { - NPY_CDOUBLE_GET_IMAG(&dres[i]) = NPY_CDOUBLE_GET_IMAG(&slope)*(x_val - dx[j+1]) + NPY_CDOUBLE_GET_IMAG(&dy[j+1]); + NPY_CDOUBLE_SET_IMAG(&dres[i], NPY_CDOUBLE_GET_IMAG(&slope)*(x_val - dx[j+1]) + NPY_CDOUBLE_GET_IMAG(&dy[j+1])); if (NPY_UNLIKELY(npy_isnan(NPY_CDOUBLE_GET_IMAG(&dres[i]))) && NPY_CDOUBLE_GET_IMAG(&dy[j]) == NPY_CDOUBLE_GET_IMAG(&dy[j+1])) { - NPY_CDOUBLE_GET_IMAG(&dres[i]) = NPY_CDOUBLE_GET_IMAG(&dy[j]); + NPY_CDOUBLE_SET_IMAG(&dres[i], NPY_CDOUBLE_GET_IMAG(&dy[j])); } } } diff --git a/numpy/core/src/multiarray/scalarapi.c b/numpy/core/src/multiarray/scalarapi.c index 5195237b90e6..e5aacd05c4d7 100644 --- a/numpy/core/src/multiarray/scalarapi.c +++ b/numpy/core/src/multiarray/scalarapi.c @@ -373,8 +373,8 @@ PyArray_ScalarFromObject(PyObject *object) else if (PyComplex_Check(object)) { ret = PyArrayScalar_New(CDouble); if (ret != NULL) { - NPY_CDOUBLE_GET_REAL(&PyArrayScalar_VAL(ret, CDouble)) = PyComplex_RealAsDouble(object); - NPY_CDOUBLE_GET_IMAG(&PyArrayScalar_VAL(ret, CDouble)) = PyComplex_ImagAsDouble(object); + NPY_CDOUBLE_SET_REAL(&PyArrayScalar_VAL(ret, CDouble), PyComplex_RealAsDouble(object)); + NPY_CDOUBLE_SET_IMAG(&PyArrayScalar_VAL(ret, CDouble), PyComplex_ImagAsDouble(object)); } return ret; } diff --git a/numpy/core/src/multiarray/textreading/conversions.c b/numpy/core/src/multiarray/textreading/conversions.c index f1c57b18a720..ae2c55303fdc 100644 --- a/numpy/core/src/multiarray/textreading/conversions.c +++ b/numpy/core/src/multiarray/textreading/conversions.c @@ -243,8 +243,8 @@ npy_to_cfloat(PyArray_Descr *descr, return -1; } npy_complex64 val; - NPY_CFLOAT_GET_REAL(&val) = (float) real; - NPY_CFLOAT_GET_IMAG(&val) = (float) imag; + NPY_CFLOAT_SET_REAL(&val, (float) real); + NPY_CFLOAT_SET_IMAG(&val, (float) imag); memcpy(dataptr, &val, sizeof(npy_complex64)); if (!PyArray_ISNBO(descr->byteorder)) { npy_bswap4_unaligned(dataptr); @@ -269,8 +269,8 @@ npy_to_cdouble(PyArray_Descr *descr, return -1; } npy_complex128 val; - NPY_CDOUBLE_GET_REAL(&val) = real; - NPY_CDOUBLE_GET_IMAG(&val) = imag; + NPY_CDOUBLE_SET_REAL(&val, real); + NPY_CDOUBLE_SET_IMAG(&val, imag); memcpy(dataptr, &val, sizeof(npy_complex128)); if (!PyArray_ISNBO(descr->byteorder)) { npy_bswap8_unaligned(dataptr); diff --git a/numpy/core/src/umath/funcs.inc.src b/numpy/core/src/umath/funcs.inc.src index 6fd37421fc57..d5662c436e74 100644 --- a/numpy/core/src/umath/funcs.inc.src +++ b/numpy/core/src/umath/funcs.inc.src @@ -292,16 +292,14 @@ npy_ObjectClip(PyObject *arr, PyObject *min, PyObject *max) { static void nc_neg@c@(@ctype@ *a, @ctype@ *r) { - NPY_@NAME@_GET_REAL(r) = -NPY_@NAME@_GET_REAL(a); - NPY_@NAME@_GET_IMAG(r) = -NPY_@NAME@_GET_IMAG(a); + *r = -(*a); return; } static void nc_pos@c@(@ctype@ *a, @ctype@ *r) { - NPY_@NAME@_GET_REAL(r) = +NPY_@NAME@_GET_REAL(a); - NPY_@NAME@_GET_IMAG(r) = +NPY_@NAME@_GET_IMAG(a); + *r = +(*a); return; } @@ -315,8 +313,8 @@ nc_sqrt@c@(@ctype@ *x, @ctype@ *r) static void nc_rint@c@(@ctype@ *x, @ctype@ *r) { - NPY_@NAME@_GET_REAL(r) = npy_rint@c@(NPY_@NAME@_GET_REAL(x)); - NPY_@NAME@_GET_IMAG(r) = npy_rint@c@(NPY_@NAME@_GET_IMAG(x)); + NPY_@NAME@_SET_REAL(r, npy_rint@c@(NPY_@NAME@_GET_REAL(x))); + NPY_@NAME@_SET_IMAG(r, npy_rint@c@(NPY_@NAME@_GET_IMAG(x))); } static void @@ -330,8 +328,8 @@ static void nc_log1p@c@(@ctype@ *x, @ctype@ *r) { @ftype@ l = npy_hypot@c@(NPY_@NAME@_GET_REAL(x) + 1,NPY_@NAME@_GET_IMAG(x)); - NPY_@NAME@_GET_IMAG(r) = npy_atan2@c@(NPY_@NAME@_GET_IMAG(x), NPY_@NAME@_GET_REAL(x) + 1); - NPY_@NAME@_GET_REAL(r) = npy_log@c@(l); + NPY_@NAME@_SET_IMAG(r, npy_atan2@c@(NPY_@NAME@_GET_IMAG(x), NPY_@NAME@_GET_REAL(x) + 1)); + NPY_@NAME@_SET_REAL(r, npy_log@c@(l)); return; } @@ -346,8 +344,8 @@ static void nc_exp2@c@(@ctype@ *x, @ctype@ *r) { @ctype@ a; - NPY_@NAME@_GET_REAL(&a) = NPY_@NAME@_GET_REAL(x)*NPY_LOGE2@c@; - NPY_@NAME@_GET_IMAG(&a) = NPY_@NAME@_GET_IMAG(x)*NPY_LOGE2@c@; + NPY_@NAME@_SET_REAL(&a, NPY_@NAME@_GET_REAL(x)*NPY_LOGE2@c@); + NPY_@NAME@_SET_IMAG(&a, NPY_@NAME@_GET_IMAG(x)*NPY_LOGE2@c@); nc_exp@c@(&a, r); return; } @@ -356,8 +354,8 @@ static void nc_expm1@c@(@ctype@ *x, @ctype@ *r) { @ftype@ a = npy_sin@c@(NPY_@NAME@_GET_IMAG(x) / 2); - NPY_@NAME@_GET_REAL(r) = npy_expm1@c@(NPY_@NAME@_GET_REAL(x)) * npy_cos@c@(NPY_@NAME@_GET_IMAG(x)) - 2 * a * a; - NPY_@NAME@_GET_IMAG(r) = npy_exp@c@(NPY_@NAME@_GET_REAL(x)) * npy_sin@c@(NPY_@NAME@_GET_IMAG(x)); + NPY_@NAME@_SET_REAL(r, npy_expm1@c@(NPY_@NAME@_GET_REAL(x)) * npy_cos@c@(NPY_@NAME@_GET_IMAG(x)) - 2 * a * a); + NPY_@NAME@_SET_IMAG(r,npy_exp@c@(NPY_@NAME@_GET_REAL(x)) * npy_sin@c@(NPY_@NAME@_GET_IMAG(x))); return; } @@ -429,8 +427,8 @@ static void nc_log10@c@(@ctype@ *x, @ctype@ *r) { nc_log@c@(x, r); - NPY_@NAME@_GET_REAL(r) *= NPY_LOG10E@c@; - NPY_@NAME@_GET_IMAG(r) *= NPY_LOG10E@c@; + NPY_@NAME@_SET_REAL(r, NPY_@NAME@_GET_REAL(r) * NPY_LOG10E@c@); + NPY_@NAME@_SET_IMAG(r, NPY_@NAME@_GET_REAL(r) * NPY_LOG10E@c@); return; } @@ -438,8 +436,8 @@ static void nc_log2@c@(@ctype@ *x, @ctype@ *r) { nc_log@c@(x, r); - NPY_@NAME@_GET_REAL(r) *= NPY_LOG2E@c@; - NPY_@NAME@_GET_IMAG(r) *= NPY_LOG2E@c@; + NPY_@NAME@_SET_REAL(r, NPY_@NAME@_GET_REAL(r) * NPY_LOG2E@c@); + NPY_@NAME@_SET_IMAG(r, NPY_@NAME@_GET_REAL(r) * NPY_LOG2E@c@); return; } diff --git a/numpy/core/src/umath/loops.c.src b/numpy/core/src/umath/loops.c.src index c6a907df4531..85fe1ac27716 100644 --- a/numpy/core/src/umath/loops.c.src +++ b/numpy/core/src/umath/loops.c.src @@ -158,8 +158,8 @@ PyUFunc_F_F_As_D_D(char **args, npy_intp const *dimensions, npy_intp const *step func_type *f = (func_type *)func; UNARY_LOOP { npy_cdouble tmp, out; - NPY_CDOUBLE_GET_REAL(&tmp) = (double)((float *)ip1)[0]; - NPY_CDOUBLE_GET_IMAG(&tmp) = (double)((float *)ip1)[1]; + NPY_CDOUBLE_SET_REAL(&tmp, (double)((float *)ip1)[0]); + NPY_CDOUBLE_SET_IMAG(&tmp, (double)((float *)ip1)[1]); f(&tmp, &out); ((float *)op1)[0] = (float)NPY_CDOUBLE_GET_REAL(&out); ((float *)op1)[1] = (float)NPY_CDOUBLE_GET_IMAG(&out); @@ -174,10 +174,10 @@ PyUFunc_FF_F_As_DD_D(char **args, npy_intp const *dimensions, npy_intp const *st func_type *f = (func_type *)func; BINARY_LOOP { npy_cdouble tmp1, tmp2, out; - NPY_CDOUBLE_GET_REAL(&tmp1) = (double)((float *)ip1)[0]; - NPY_CDOUBLE_GET_IMAG(&tmp1) = (double)((float *)ip1)[1]; - NPY_CDOUBLE_GET_REAL(&tmp2) = (double)((float *)ip2)[0]; - NPY_CDOUBLE_GET_IMAG(&tmp2) = (double)((float *)ip2)[1]; + NPY_CDOUBLE_SET_REAL(&tmp1, (double)((float *)ip1)[0]); + NPY_CDOUBLE_SET_IMAG(&tmp1, (double)((float *)ip1)[1]); + NPY_CDOUBLE_SET_REAL(&tmp2, (double)((float *)ip2)[0]); + NPY_CDOUBLE_SET_IMAG(&tmp2, (double)((float *)ip2)[1]); f(&tmp1, &tmp2, &out); ((float *)op1)[0] = (float)NPY_CDOUBLE_GET_REAL(&out); ((float *)op1)[1] = (float)NPY_CDOUBLE_GET_IMAG(&out); diff --git a/numpy/core/src/umath/matmul.c.src b/numpy/core/src/umath/matmul.c.src index ebaeef92a0fb..72a7d38da222 100644 --- a/numpy/core/src/umath/matmul.c.src +++ b/numpy/core/src/umath/matmul.c.src @@ -231,10 +231,7 @@ NPY_NO_EXPORT void for (m = 0; m < dm; m++) { for (p = 0; p < dp; p++) { -#if @IS_COMPLEX@ == 1 - NPY_@TYPE@_GET_REAL(op) = 0; - NPY_@TYPE@_GET_IMAG(op) = 0; -#elif @IS_HALF@ +#if @IS_HALF@ float sum = 0; #else *(@typ@ *)op = 0; @@ -245,10 +242,10 @@ NPY_NO_EXPORT void #if @IS_HALF@ sum += npy_half_to_float(val1) * npy_half_to_float(val2); #elif @IS_COMPLEX@ == 1 - NPY_@TYPE@_GET_REAL(op) += (NPY_@TYPE@_GET_REAL(&val1) * NPY_@TYPE@_GET_REAL(&val2)) - - (NPY_@TYPE@_GET_IMAG(&val1) * NPY_@TYPE@_GET_IMAG(&val2)); - NPY_@TYPE@_GET_IMAG(op) += (NPY_@TYPE@_GET_REAL(&val1) * NPY_@TYPE@_GET_IMAG(&val2)) + - (NPY_@TYPE@_GET_IMAG(&val1) * NPY_@TYPE@_GET_REAL(&val2)); + NPY_@TYPE@_SET_REAL((@typ@ *) op, NPY_@TYPE@_GET_REAL((@typ@ *) op) + (NPY_@TYPE@_GET_REAL(&val1) * NPY_@TYPE@_GET_REAL(&val2)) - + (NPY_@TYPE@_GET_IMAG(&val1) * NPY_@TYPE@_GET_IMAG(&val2))); + NPY_@TYPE@_SET_IMAG((@typ@ *) op, NPY_@TYPE@_GET_REAL((@typ@ *) op) + (NPY_@TYPE@_GET_REAL(&val1) * NPY_@TYPE@_GET_IMAG(&val2)) + + (NPY_@TYPE@_GET_IMAG(&val1) * NPY_@TYPE@_GET_REAL(&val2))); #else *(@typ@ *)op += val1 * val2; #endif diff --git a/numpy/core/src/umath/scalarmath.c.src b/numpy/core/src/umath/scalarmath.c.src index 4f7da24c1d17..1d5181d37c8e 100644 --- a/numpy/core/src/umath/scalarmath.c.src +++ b/numpy/core/src/umath/scalarmath.c.src @@ -422,16 +422,14 @@ half_ctype_divmod(npy_half a, npy_half b, npy_half *out1, npy_half *out2) static inline int @name@_ctype_add(@type@ a, @type@ b, @type@ *out) { - NPY_@TYPE@_GET_REAL(out) = NPY_@TYPE@_GET_REAL(&a) + NPY_@TYPE@_GET_REAL(&b); - NPY_@TYPE@_GET_IMAG(out) = NPY_@TYPE@_GET_IMAG(&a) + NPY_@TYPE@_GET_IMAG(&b); + *out = a + b; return 0; } static inline int @name@_ctype_subtract(@type@ a, @type@ b, @type@ *out) { - NPY_@TYPE@_GET_REAL(out) = NPY_@TYPE@_GET_REAL(&a) - NPY_@TYPE@_GET_REAL(&b); - NPY_@TYPE@_GET_IMAG(out) = NPY_@TYPE@_GET_IMAG(&a) - NPY_@TYPE@_GET_IMAG(&b); + *out = a - b; return 0; } @@ -443,8 +441,8 @@ static inline int static inline int @name@_ctype_multiply( @type@ a, @type@ b, @type@ *out) { - NPY_@TYPE@_GET_REAL(out) = NPY_@TYPE@_GET_REAL(&a) * NPY_@TYPE@_GET_REAL(&b) - NPY_@TYPE@_GET_IMAG(&a) * NPY_@TYPE@_GET_IMAG(&b); - NPY_@TYPE@_GET_IMAG(out) = NPY_@TYPE@_GET_REAL(&a) * NPY_@TYPE@_GET_IMAG(&b) + NPY_@TYPE@_GET_IMAG(&a) * NPY_@TYPE@_GET_REAL(&b); + NPY_@TYPE@_SET_REAL(out, NPY_@TYPE@_GET_REAL(&a) * NPY_@TYPE@_GET_REAL(&b) - NPY_@TYPE@_GET_IMAG(&a) * NPY_@TYPE@_GET_IMAG(&b)); + NPY_@TYPE@_SET_IMAG(out, NPY_@TYPE@_GET_REAL(&a) * NPY_@TYPE@_GET_IMAG(&b) + NPY_@TYPE@_GET_IMAG(&a) * NPY_@TYPE@_GET_REAL(&b)); return 0; } @@ -557,8 +555,7 @@ half_ctype_negative(npy_half a, npy_half *out) static inline int @name@_ctype_negative(@type@ a, @type@ *out) { - NPY_@NAME@_GET_REAL(out) = -NPY_@NAME@_GET_REAL(&a); - NPY_@NAME@_GET_IMAG(out) = -NPY_@NAME@_GET_IMAG(&a); + *out = -a; return 0; } /**end repeat**/ @@ -588,8 +585,7 @@ static inline int static inline int @name@_ctype_positive(@type@ a, @type@ *out) { - NPY_@NAME@_GET_REAL(out) = NPY_@NAME@_GET_REAL(&a); - NPY_@NAME@_GET_IMAG(out) = NPY_@NAME@_GET_IMAG(&a); + *out = +a; return 0; } @@ -854,8 +850,8 @@ typedef enum { *result = npy_float_to_half((float)(value)) #elif defined(IS_CFLOAT) || defined(IS_CDOUBLE) || defined(IS_CLONGDOUBLE) #define CONVERT_TO_RESULT(value) \ - NPY_@TYPE@_GET_REAL(result) = value; \ - NPY_@TYPE@_GET_IMAG(result) = 0 + NPY_@TYPE@_SET_REAL(result, value); \ + NPY_@TYPE@_SET_IMAG(result, 0) #else #define CONVERT_TO_RESULT(value) *result = value #endif @@ -890,8 +886,8 @@ typedef enum { case NPY_##OTHER: \ if (IS_SAFE(NPY_##OTHER, NPY_@TYPE@)) { \ assert(Py_TYPE(value) == &Py##Other##ArrType_Type); \ - NPY_@TYPE@_GET_REAL(result) = NPY_##OTHER##_GET_REAL(&PyArrayScalar_VAL(value, Other)); \ - NPY_@TYPE@_GET_IMAG(result) = NPY_##OTHER##_GET_IMAG(&PyArrayScalar_VAL(value, Other)); \ + NPY_@TYPE@_SET_REAL(result, NPY_##OTHER##_GET_REAL(&PyArrayScalar_VAL(value, Other))); \ + NPY_@TYPE@_SET_IMAG(result, NPY_##OTHER##_GET_IMAG(&PyArrayScalar_VAL(value, Other))); \ ret = 1; \ } \ else if (IS_SAFE(NPY_@TYPE@, NPY_##OTHER)) { \ @@ -1042,8 +1038,8 @@ convert_to_@name@(PyObject *value, @type@ *result, npy_bool *may_need_deferring) if (error_converting(val.real)) { return CONVERSION_ERROR; /* should not be possible */ } - NPY_@TYPE@_GET_REAL(result) = val.real; - NPY_@TYPE@_GET_IMAG(result) = val.imag; + NPY_@TYPE@_SET_REAL(result, val.real); + NPY_@TYPE@_SET_IMAG(result, val.imag); return CONVERSION_SUCCESS; #else /* unreachable, always unsafe cast above; return to avoid warning */ From 6050aad1e2bb426ceeb97f4245c765e1b6870d08 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 30 Jun 2023 11:33:28 +0200 Subject: [PATCH 08/40] Fix call to memset with std::complex in umath_linalg --- numpy/linalg/umath_linalg.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/numpy/linalg/umath_linalg.cpp b/numpy/linalg/umath_linalg.cpp index 481a6c8617a6..42434d7120a7 100644 --- a/numpy/linalg/umath_linalg.cpp +++ b/numpy/linalg/umath_linalg.cpp @@ -975,7 +975,7 @@ identity_matrix(typ *matrix, size_t n) { size_t i; /* in IEEE floating point, zeroes are represented as bitwise 0 */ - memset(matrix, 0, n*n*sizeof(typ)); + memset((void *)matrix, 0, n*n*sizeof(typ)); for (i = 0; i < n; ++i) { From a7fea9b28839f10d5ca7f97748c1bbdb3a73f208 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 30 Jun 2023 13:55:04 +0200 Subject: [PATCH 09/40] Fix call to SET_REAL/SET_IMAG in umath matmul --- numpy/core/src/umath/matmul.c.src | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/numpy/core/src/umath/matmul.c.src b/numpy/core/src/umath/matmul.c.src index 72a7d38da222..64774502f0c7 100644 --- a/numpy/core/src/umath/matmul.c.src +++ b/numpy/core/src/umath/matmul.c.src @@ -242,10 +242,10 @@ NPY_NO_EXPORT void #if @IS_HALF@ sum += npy_half_to_float(val1) * npy_half_to_float(val2); #elif @IS_COMPLEX@ == 1 - NPY_@TYPE@_SET_REAL((@typ@ *) op, NPY_@TYPE@_GET_REAL((@typ@ *) op) + (NPY_@TYPE@_GET_REAL(&val1) * NPY_@TYPE@_GET_REAL(&val2)) - - (NPY_@TYPE@_GET_IMAG(&val1) * NPY_@TYPE@_GET_IMAG(&val2))); - NPY_@TYPE@_SET_IMAG((@typ@ *) op, NPY_@TYPE@_GET_REAL((@typ@ *) op) + (NPY_@TYPE@_GET_REAL(&val1) * NPY_@TYPE@_GET_IMAG(&val2)) + - (NPY_@TYPE@_GET_IMAG(&val1) * NPY_@TYPE@_GET_REAL(&val2))); + NPY_@TYPE@_SET_REAL((@typ@ *) op, NPY_@TYPE@_GET_REAL((@typ@ *) op) + ((NPY_@TYPE@_GET_REAL(&val1) * NPY_@TYPE@_GET_REAL(&val2)) - + (NPY_@TYPE@_GET_IMAG(&val1) * NPY_@TYPE@_GET_IMAG(&val2)))); + NPY_@TYPE@_SET_IMAG((@typ@ *) op, NPY_@TYPE@_GET_IMAG((@typ@ *) op) + ((NPY_@TYPE@_GET_REAL(&val1) * NPY_@TYPE@_GET_IMAG(&val2)) + + (NPY_@TYPE@_GET_IMAG(&val1) * NPY_@TYPE@_GET_REAL(&val2)))); #else *(@typ@ *)op += val1 * val2; #endif From 87490828c4afefb10315bac7ef1bd65b385550c4 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 30 Jun 2023 14:04:13 +0200 Subject: [PATCH 10/40] Remove c99 compat layer from npymath --- numpy/core/src/npymath/npy_math_complex.c.src | 20 +---- numpy/core/src/npymath/npy_math_private.h | 76 ------------------- 2 files changed, 4 insertions(+), 92 deletions(-) diff --git a/numpy/core/src/npymath/npy_math_complex.c.src b/numpy/core/src/npymath/npy_math_complex.c.src index eb9d810b7d82..50acf2e69fb1 100644 --- a/numpy/core/src/npymath/npy_math_complex.c.src +++ b/numpy/core/src/npymath/npy_math_complex.c.src @@ -64,7 +64,7 @@ static const volatile npy_float tiny = 3.9443045e-31f; /*========================================================== * Constants *=========================================================*/ -static const @ctype@ c_1@c@ = {1.0@C@, 0.0}; +static const @ctype@ c_1@c@ = 1.0@C@; /*========================================================== * Helper functions @@ -422,13 +422,7 @@ npy_csqrt@c@(@ctype@ z) static @ctype@ sys_cpow@c@(@ctype@ x, @ctype@ y) { - __@ctype@_to_c99_cast xcast; - __@ctype@_to_c99_cast ycast; - __@ctype@_to_c99_cast ret; - xcast.npy_z = x; - ycast.npy_z = y; - ret.c99_z = cpow@c@(xcast.c99_z, ycast.c99_z); - return ret.npy_z; + return cpow@c@(x, y); } #endif @@ -1756,9 +1750,7 @@ npy_catanh@c@(@ctype@ z) @type@ npy_@kind@@c@(@ctype@ z) { - __@ctype@_to_c99_cast z1; - z1.npy_z = z; - return @kind@@c@(z1.c99_z); + return @kind@@c@(z); } #endif /**end repeat1**/ @@ -1773,11 +1765,7 @@ npy_@kind@@c@(@ctype@ z) @ctype@ npy_@kind@@c@(@ctype@ z) { - __@ctype@_to_c99_cast z1; - __@ctype@_to_c99_cast ret; - z1.npy_z = z; - ret.c99_z = @kind@@c@(z1.c99_z); - return ret.npy_z; + return @kind@@c@(z); } #endif /**end repeat1**/ diff --git a/numpy/core/src/npymath/npy_math_private.h b/numpy/core/src/npymath/npy_math_private.h index 20c94f98a3d7..8fa7316e2dc3 100644 --- a/numpy/core/src/npymath/npy_math_private.h +++ b/numpy/core/src/npymath/npy_math_private.h @@ -21,7 +21,6 @@ #include #ifdef __cplusplus #include -#include using std::isgreater; using std::isless; #else @@ -484,79 +483,4 @@ do { \ #endif /* !HAVE_LDOUBLE_DOUBLE_DOUBLE_* */ -/* - * Those unions are used to convert a pointer of npy_cdouble to native C99 - * complex or our own complex type independently on whether C99 complex - * support is available - */ -#ifdef NPY_USE_C99_COMPLEX - -/* - * Microsoft C defines _MSC_VER - * Intel compiler does not use MSVC complex types, but defines _MSC_VER by - * default. - * since c++17 msvc is no longer support them. - */ -#if !defined(__cplusplus) && defined(_MSC_VER) && !defined(__INTEL_COMPILER) -typedef union { - npy_cdouble npy_z; - _Dcomplex c99_z; -} __npy_cdouble_to_c99_cast; - -typedef union { - npy_cfloat npy_z; - _Fcomplex c99_z; -} __npy_cfloat_to_c99_cast; - -typedef union { - npy_clongdouble npy_z; - _Lcomplex c99_z; -} __npy_clongdouble_to_c99_cast; -#else /* !_MSC_VER */ -typedef union { - npy_cdouble npy_z; -#ifdef __cplusplus - std::complex c99_z; -#else - complex double c99_z; -#endif -} __npy_cdouble_to_c99_cast; - -typedef union { - npy_cfloat npy_z; -#ifdef __cplusplus - std::complex c99_z; -#else - complex float c99_z; -#endif -} __npy_cfloat_to_c99_cast; - -typedef union { - npy_clongdouble npy_z; -#ifdef __cplusplus - std::complex c99_z; -#else - complex long double c99_z; -#endif -} __npy_clongdouble_to_c99_cast; -#endif /* !_MSC_VER */ - -#else /* !NPY_USE_C99_COMPLEX */ -typedef union { - npy_cdouble npy_z; - npy_cdouble c99_z; -} __npy_cdouble_to_c99_cast; - -typedef union { - npy_cfloat npy_z; - npy_cfloat c99_z; -} __npy_cfloat_to_c99_cast; - -typedef union { - npy_clongdouble npy_z; - npy_clongdouble c99_z; -} __npy_clongdouble_to_c99_cast; -#endif /* !NPY_USE_C99_COMPLEX */ - - #endif /* !_NPY_MATH_PRIVATE_H_ */ From ea282c7038555feb19af570e2fd40538bd6e7519 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 30 Jun 2023 15:06:22 +0200 Subject: [PATCH 11/40] Fix log10 and log2 --- numpy/core/src/umath/funcs.inc.src | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/numpy/core/src/umath/funcs.inc.src b/numpy/core/src/umath/funcs.inc.src index d5662c436e74..9be3a356890c 100644 --- a/numpy/core/src/umath/funcs.inc.src +++ b/numpy/core/src/umath/funcs.inc.src @@ -428,7 +428,7 @@ nc_log10@c@(@ctype@ *x, @ctype@ *r) { nc_log@c@(x, r); NPY_@NAME@_SET_REAL(r, NPY_@NAME@_GET_REAL(r) * NPY_LOG10E@c@); - NPY_@NAME@_SET_IMAG(r, NPY_@NAME@_GET_REAL(r) * NPY_LOG10E@c@); + NPY_@NAME@_SET_IMAG(r, NPY_@NAME@_GET_IMAG(r) * NPY_LOG10E@c@); return; } @@ -437,7 +437,7 @@ nc_log2@c@(@ctype@ *x, @ctype@ *r) { nc_log@c@(x, r); NPY_@NAME@_SET_REAL(r, NPY_@NAME@_GET_REAL(r) * NPY_LOG2E@c@); - NPY_@NAME@_SET_IMAG(r, NPY_@NAME@_GET_REAL(r) * NPY_LOG2E@c@); + NPY_@NAME@_SET_IMAG(r, NPY_@NAME@_GET_IMAG(r) * NPY_LOG2E@c@); return; } From a926e013f6f16600b000e35623cb180cb561ecb9 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 30 Jun 2023 15:19:00 +0200 Subject: [PATCH 12/40] Fix initialization of complex in npy_math_complex --- numpy/core/src/npymath/npy_math_complex.c.src | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/numpy/core/src/npymath/npy_math_complex.c.src b/numpy/core/src/npymath/npy_math_complex.c.src index 50acf2e69fb1..1120bf438c87 100644 --- a/numpy/core/src/npymath/npy_math_complex.c.src +++ b/numpy/core/src/npymath/npy_math_complex.c.src @@ -64,7 +64,13 @@ static const volatile npy_float tiny = 3.9443045e-31f; /*========================================================== * Constants *=========================================================*/ +#if !defined(__cplusplus) && defined(_MSC_VER) && !defined(__INTEL_COMPILER) +static const @ctype@ c_1@c@ = {1.0@C@, 0.0@C@}; +#elif defined(__cplusplus) +static const @ctype@ c_1@c@ (1.0@C@, 0.0@C@); +#else static const @ctype@ c_1@c@ = 1.0@C@; +#endif /*========================================================== * Helper functions From 2b2c597756553e7488d64b32b4088ad000bb0b4e Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Tue, 4 Jul 2023 17:40:43 +0200 Subject: [PATCH 13/40] First attempt to fix CI // Add static inline --- numpy/core/include/numpy/npy_common.h | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index b0326fbf3802..9c21168088a8 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -419,7 +419,7 @@ typedef union { } _npy_clongdouble_to_arr; #endif -inline double NPY_CDOUBLE_GET_REAL(const npy_cdouble *c) { +static inline double NPY_CDOUBLE_GET_REAL(const npy_cdouble *c) { #ifdef __cplusplus return reinterpret_cast(c)[0]; #else @@ -429,7 +429,7 @@ inline double NPY_CDOUBLE_GET_REAL(const npy_cdouble *c) { #endif } -inline double NPY_CDOUBLE_GET_IMAG(const npy_cdouble *c) { +static inline double NPY_CDOUBLE_GET_IMAG(const npy_cdouble *c) { #ifdef __cplusplus return reinterpret_cast(c)[1]; #else @@ -439,7 +439,7 @@ inline double NPY_CDOUBLE_GET_IMAG(const npy_cdouble *c) { #endif } -inline void NPY_CDOUBLE_SET_REAL(npy_cdouble *c, double real) { +static inline void NPY_CDOUBLE_SET_REAL(npy_cdouble *c, double real) { #ifdef __cplusplus double *tmp = reinterpret_cast(c); tmp[0] = real; @@ -450,7 +450,7 @@ inline void NPY_CDOUBLE_SET_REAL(npy_cdouble *c, double real) { #endif } -inline void NPY_CDOUBLE_SET_IMAG(npy_cdouble *c, double imag) { +static inline void NPY_CDOUBLE_SET_IMAG(npy_cdouble *c, double imag) { #ifdef __cplusplus double *tmp = reinterpret_cast(c); tmp[1] = imag; @@ -461,7 +461,7 @@ inline void NPY_CDOUBLE_SET_IMAG(npy_cdouble *c, double imag) { #endif } -inline float NPY_CFLOAT_GET_REAL(const npy_cfloat *c) { +static inline float NPY_CFLOAT_GET_REAL(const npy_cfloat *c) { #ifdef __cplusplus return reinterpret_cast(c)[0]; #else @@ -471,7 +471,7 @@ inline float NPY_CFLOAT_GET_REAL(const npy_cfloat *c) { #endif } -inline float NPY_CFLOAT_GET_IMAG(const npy_cfloat *c) { +static inline float NPY_CFLOAT_GET_IMAG(const npy_cfloat *c) { #ifdef __cplusplus return reinterpret_cast(c)[1]; #else @@ -481,7 +481,7 @@ inline float NPY_CFLOAT_GET_IMAG(const npy_cfloat *c) { #endif } -inline void NPY_CFLOAT_SET_REAL(npy_cfloat *c, float real) { +static inline void NPY_CFLOAT_SET_REAL(npy_cfloat *c, float real) { #ifdef __cplusplus float *tmp = reinterpret_cast(c); tmp[0] = real; @@ -492,7 +492,7 @@ inline void NPY_CFLOAT_SET_REAL(npy_cfloat *c, float real) { #endif } -inline void NPY_CFLOAT_SET_IMAG(npy_cfloat *c, float imag) { +static inline void NPY_CFLOAT_SET_IMAG(npy_cfloat *c, float imag) { #ifdef __cplusplus float *tmp = reinterpret_cast(c); tmp[1] = imag; @@ -503,7 +503,7 @@ inline void NPY_CFLOAT_SET_IMAG(npy_cfloat *c, float imag) { #endif } -inline longdouble_t NPY_CLONGDOUBLE_GET_REAL(const npy_clongdouble *c) { +static inline longdouble_t NPY_CLONGDOUBLE_GET_REAL(const npy_clongdouble *c) { #ifdef __cplusplus return reinterpret_cast(c)[0]; #else @@ -513,7 +513,7 @@ inline longdouble_t NPY_CLONGDOUBLE_GET_REAL(const npy_clongdouble *c) { #endif } -inline longdouble_t NPY_CLONGDOUBLE_GET_IMAG(const npy_clongdouble *c) { +static inline longdouble_t NPY_CLONGDOUBLE_GET_IMAG(const npy_clongdouble *c) { #ifdef __cplusplus return reinterpret_cast(c)[1]; #else @@ -523,7 +523,7 @@ inline longdouble_t NPY_CLONGDOUBLE_GET_IMAG(const npy_clongdouble *c) { #endif } -inline void NPY_CLONGDOUBLE_SET_REAL(npy_clongdouble *c, longdouble_t real) { +static inline void NPY_CLONGDOUBLE_SET_REAL(npy_clongdouble *c, longdouble_t real) { #ifdef __cplusplus longdouble_t *tmp = reinterpret_cast(c); tmp[0] = real; @@ -534,7 +534,7 @@ inline void NPY_CLONGDOUBLE_SET_REAL(npy_clongdouble *c, longdouble_t real) { #endif } -inline void NPY_CLONGDOUBLE_SET_IMAG(npy_clongdouble *c, longdouble_t imag) { +static inline void NPY_CLONGDOUBLE_SET_IMAG(npy_clongdouble *c, longdouble_t imag) { #ifdef __cplusplus longdouble_t *tmp = reinterpret_cast(c); tmp[1] = imag; From ad607989fdec3eb92ce9a1117528c2dedcf74440 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Wed, 5 Jul 2023 12:38:37 +0200 Subject: [PATCH 14/40] Fix inline setters --- numpy/core/include/numpy/npy_common.h | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index 9c21168088a8..2bc99e93d40c 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -445,6 +445,7 @@ static inline void NPY_CDOUBLE_SET_REAL(npy_cdouble *c, double real) { tmp[0] = real; #else _npy_cdouble_to_arr tmp; + tmp.comp = *c; tmp.arr[0] = real; *c = tmp.comp; #endif @@ -456,6 +457,7 @@ static inline void NPY_CDOUBLE_SET_IMAG(npy_cdouble *c, double imag) { tmp[1] = imag; #else _npy_cdouble_to_arr tmp; + tmp.comp = *c; tmp.arr[1] = imag; *c = tmp.comp; #endif @@ -487,6 +489,7 @@ static inline void NPY_CFLOAT_SET_REAL(npy_cfloat *c, float real) { tmp[0] = real; #else _npy_cfloat_to_arr tmp; + tmp.comp = *c; tmp.arr[0] = real; *c = tmp.comp; #endif @@ -498,6 +501,7 @@ static inline void NPY_CFLOAT_SET_IMAG(npy_cfloat *c, float imag) { tmp[1] = imag; #else _npy_cfloat_to_arr tmp; + tmp.comp = *c; tmp.arr[1] = imag; *c = tmp.comp; #endif @@ -529,6 +533,7 @@ static inline void NPY_CLONGDOUBLE_SET_REAL(npy_clongdouble *c, longdouble_t rea tmp[0] = real; #else _npy_clongdouble_to_arr tmp; + tmp.comp = *c; tmp.arr[0] = real; *c = tmp.comp; #endif @@ -540,6 +545,7 @@ static inline void NPY_CLONGDOUBLE_SET_IMAG(npy_clongdouble *c, longdouble_t ima tmp[1] = imag; #else _npy_clongdouble_to_arr tmp; + tmp.comp = *c; tmp.arr[1] = imag; *c = tmp.comp; #endif From f65c6434742b52f09bb1b6f47caaa7749ce8ca5a Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Wed, 5 Jul 2023 15:32:10 +0200 Subject: [PATCH 15/40] Initialize complex numbers --- numpy/core/include/numpy/npy_common.h | 9 +++++++++ numpy/core/include/numpy/npy_math.h | 6 +++--- numpy/core/src/multiarray/arraytypes.c.src | 9 ++++++--- numpy/core/src/multiarray/compiled_base.c | 4 ++-- numpy/core/src/multiarray/textreading/conversions.c | 4 ++-- numpy/core/src/npymath/npy_math_complex.c.src | 9 ++------- numpy/core/src/umath/funcs.inc.src | 2 +- numpy/core/src/umath/loops.c.src | 4 ++-- 8 files changed, 27 insertions(+), 20 deletions(-) diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index 2bc99e93d40c..9925f77e7e7f 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -392,14 +392,23 @@ extern "C++" { typedef _Dcomplex npy_cdouble; typedef _Fcomplex npy_cfloat; typedef _Lcomplex npy_clongdouble; +#define NPY_CDOUBLE_INIT(real, imag) _CBuild(real, imag) +#define NPY_CFLOAT_INIT(real, imag) _FCBuild(real, imag) +#define NPY_CLONGDOUBLE_INIT(real, imag) _LCBuild(real, imag) #elif defined(__cplusplus) /* && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ typedef std::complex npy_cdouble; typedef std::complex npy_cfloat; typedef std::complex npy_clongdouble; +#define NPY_CDOUBLE_INIT(real, imag) std::complex(real, imag) +#define NPY_CFLOAT_INIT(real, imag) std::complex(real, imag) +#define NPY_CLONGDOUBLE_INIT(real, imag) std::complex(real, imag) #else /* !defined(__cplusplus) && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ typedef complex double npy_cdouble; typedef complex float npy_cfloat; typedef complex longdouble_t npy_clongdouble; +#define NPY_CDOUBLE_INIT(real, imag) CMPLX(real, imag) +#define NPY_CFLOAT_INIT(real, imag) CMPLXF(real, imag) +#define NPY_CLONGDOUBLE_INIT(real, imag) CMPLXL(real, imag) #endif #ifndef __cplusplus diff --git a/numpy/core/include/numpy/npy_math.h b/numpy/core/include/numpy/npy_math.h index 066c3d3e609a..410683d215c1 100644 --- a/numpy/core/include/numpy/npy_math.h +++ b/numpy/core/include/numpy/npy_math.h @@ -359,7 +359,7 @@ NPY_INPLACE npy_longdouble npy_heavisidel(npy_longdouble x, npy_longdouble h0); static inline npy_cdouble npy_cpack(double x, double y) { - npy_cdouble z; + npy_cdouble z = NPY_CDOUBLE_INIT(0.0, 0.0); NPY_CDOUBLE_SET_REAL(&z, x); NPY_CDOUBLE_SET_IMAG(&z, y); return z; @@ -367,7 +367,7 @@ static inline npy_cdouble npy_cpack(double x, double y) static inline npy_cfloat npy_cpackf(float x, float y) { - npy_cfloat z; + npy_cfloat z = NPY_CFLOAT_INIT(0.0f, 0.0f); NPY_CFLOAT_SET_REAL(&z, x); NPY_CFLOAT_SET_IMAG(&z, y); return z; @@ -375,7 +375,7 @@ static inline npy_cfloat npy_cpackf(float x, float y) static inline npy_clongdouble npy_cpackl(npy_longdouble x, npy_longdouble y) { - npy_clongdouble z; + npy_clongdouble z = NPY_CLONGDOUBLE_INIT(0.0l, 0.0l); NPY_CLONGDOUBLE_SET_REAL(&z, x); NPY_CLONGDOUBLE_SET_IMAG(&z, y); return z; diff --git a/numpy/core/src/multiarray/arraytypes.c.src b/numpy/core/src/multiarray/arraytypes.c.src index 07399b1681a1..21a59771c5c2 100644 --- a/numpy/core/src/multiarray/arraytypes.c.src +++ b/numpy/core/src/multiarray/arraytypes.c.src @@ -442,13 +442,14 @@ static PyObject * * #type = npy_cfloat, npy_cdouble, npy_clongdouble# * #ftype = npy_float, npy_double, npy_longdouble# * #kind = CFloat, CDouble, CLongDouble# + * #c = f, , l# */ NPY_NO_EXPORT int @NAME@_setitem(PyObject *op, void *ov, void *vap) { PyArrayObject *ap = vap; Py_complex oop; - @type@ temp; + @type@ temp = NPY_@NAME@_INIT(0.0@c@, 0.0@c@); if (PyArray_IsZeroDim(op)) { return convert_to_scalar_and_retry(op, ov, vap, @NAME@_setitem); @@ -1934,6 +1935,7 @@ BOOL_scan(FILE *fp, npy_bool *ip, void *NPY_UNUSED(ignore), /**begin repeat * #fname = CFLOAT, CDOUBLE# * #type = npy_cfloat, npy_cdouble# + * #c = f, # */ static int @fname@_scan(FILE *fp, @type@ *ip, void *NPY_UNUSED(ignore), @@ -1943,7 +1945,7 @@ static int int ret_real, ret_imag; ret_real = NumPyOS_ascii_ftolf(fp, &result); - @type@ output; + @type@ output = NPY_@fname@_INIT(0.0@c@, 0.0@c@); // Peek next character char next = getc(fp); if ((next == '+') || (next == '-')) { @@ -2077,6 +2079,7 @@ BOOL_fromstr(char *str, void *ip, char **endptr, /**begin repeat * #fname = CFLOAT, CDOUBLE# * #type = npy_cfloat, npy_cdouble# + * #c = f, # */ static int @fname@_fromstr(char *str, void *ip, char **endptr, @@ -2085,7 +2088,7 @@ static int double result; result = NumPyOS_ascii_strtod(str, endptr); - @type@ output; + @type@ output = NPY_@fname@_INIT(0.0@c@, 0.0@c@); if (endptr && ((*endptr[0] == '+') || (*endptr[0] == '-'))) { // Imaginary component specified diff --git a/numpy/core/src/multiarray/compiled_base.c b/numpy/core/src/multiarray/compiled_base.c index 656184fd522c..a41264deec81 100644 --- a/numpy/core/src/multiarray/compiled_base.c +++ b/numpy/core/src/multiarray/compiled_base.c @@ -675,7 +675,7 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t const npy_double *dx, *dz; const npy_cdouble *dy; - npy_cdouble lval, rval; + npy_cdouble lval = NPY_CDOUBLE_INIT(0.0, 0.0), rval = NPY_CDOUBLE_INIT(0.0, 0.0); npy_cdouble *dres, *slopes = NULL; NPY_BEGIN_THREADS_DEF; @@ -817,7 +817,7 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t dres[i] = dy[j]; } else { - npy_cdouble slope; + npy_cdouble slope = NPY_CDOUBLE_INIT(0.0, 0.0); if (slopes != NULL) { slope = slopes[j]; } diff --git a/numpy/core/src/multiarray/textreading/conversions.c b/numpy/core/src/multiarray/textreading/conversions.c index ae2c55303fdc..0142a7e3480d 100644 --- a/numpy/core/src/multiarray/textreading/conversions.c +++ b/numpy/core/src/multiarray/textreading/conversions.c @@ -242,7 +242,7 @@ npy_to_cfloat(PyArray_Descr *descr, if (!success) { return -1; } - npy_complex64 val; + npy_complex64 val = NPY_CFLOAT_INIT(0.0f, 0.0f); NPY_CFLOAT_SET_REAL(&val, (float) real); NPY_CFLOAT_SET_IMAG(&val, (float) imag); memcpy(dataptr, &val, sizeof(npy_complex64)); @@ -268,7 +268,7 @@ npy_to_cdouble(PyArray_Descr *descr, if (!success) { return -1; } - npy_complex128 val; + npy_complex128 val = NPY_CDOUBLE_INIT(0.0, 0.0); NPY_CDOUBLE_SET_REAL(&val, real); NPY_CDOUBLE_SET_IMAG(&val, imag); memcpy(dataptr, &val, sizeof(npy_complex128)); diff --git a/numpy/core/src/npymath/npy_math_complex.c.src b/numpy/core/src/npymath/npy_math_complex.c.src index 1120bf438c87..fd181e6671a6 100644 --- a/numpy/core/src/npymath/npy_math_complex.c.src +++ b/numpy/core/src/npymath/npy_math_complex.c.src @@ -54,6 +54,7 @@ static const volatile npy_float tiny = 3.9443045e-31f; * #ctype = npy_cfloat,npy_cdouble,npy_clongdouble# * #c = f, , l# * #C = F, , L# + * #NAME = CFLOAT, CDOUBLE, CLONGDOUBLE# * #TMAX = FLT_MAX, DBL_MAX, LDBL_MAX# * #TMIN = FLT_MIN, DBL_MIN, LDBL_MIN# * #TMANT_DIG = FLT_MANT_DIG, DBL_MANT_DIG, LDBL_MANT_DIG# @@ -64,13 +65,7 @@ static const volatile npy_float tiny = 3.9443045e-31f; /*========================================================== * Constants *=========================================================*/ -#if !defined(__cplusplus) && defined(_MSC_VER) && !defined(__INTEL_COMPILER) -static const @ctype@ c_1@c@ = {1.0@C@, 0.0@C@}; -#elif defined(__cplusplus) -static const @ctype@ c_1@c@ (1.0@C@, 0.0@C@); -#else -static const @ctype@ c_1@c@ = 1.0@C@; -#endif +static const @ctype@ c_1@c@ = NPY_@NAME@_INIT(1.0@C@, 0.0@C@); /*========================================================== * Helper functions diff --git a/numpy/core/src/umath/funcs.inc.src b/numpy/core/src/umath/funcs.inc.src index 9be3a356890c..79a7c9db20db 100644 --- a/numpy/core/src/umath/funcs.inc.src +++ b/numpy/core/src/umath/funcs.inc.src @@ -343,7 +343,7 @@ nc_exp@c@(@ctype@ *x, @ctype@ *r) static void nc_exp2@c@(@ctype@ *x, @ctype@ *r) { - @ctype@ a; + @ctype@ a = NPY_@NAME@_INIT(0.0@c@, 0.0@c@); NPY_@NAME@_SET_REAL(&a, NPY_@NAME@_GET_REAL(x)*NPY_LOGE2@c@); NPY_@NAME@_SET_IMAG(&a, NPY_@NAME@_GET_IMAG(x)*NPY_LOGE2@c@); nc_exp@c@(&a, r); diff --git a/numpy/core/src/umath/loops.c.src b/numpy/core/src/umath/loops.c.src index 85fe1ac27716..8324e1818a91 100644 --- a/numpy/core/src/umath/loops.c.src +++ b/numpy/core/src/umath/loops.c.src @@ -157,7 +157,7 @@ PyUFunc_F_F_As_D_D(char **args, npy_intp const *dimensions, npy_intp const *step typedef void func_type(npy_cdouble *, npy_cdouble *); func_type *f = (func_type *)func; UNARY_LOOP { - npy_cdouble tmp, out; + npy_cdouble tmp = NPY_CDOUBLE_INIT(0.0, 0.0), out = NPY_CDOUBLE_INIT(0.0, 0.0); NPY_CDOUBLE_SET_REAL(&tmp, (double)((float *)ip1)[0]); NPY_CDOUBLE_SET_IMAG(&tmp, (double)((float *)ip1)[1]); f(&tmp, &out); @@ -173,7 +173,7 @@ PyUFunc_FF_F_As_DD_D(char **args, npy_intp const *dimensions, npy_intp const *st typedef void func_type(npy_cdouble *, npy_cdouble *, npy_cdouble *); func_type *f = (func_type *)func; BINARY_LOOP { - npy_cdouble tmp1, tmp2, out; + npy_cdouble tmp1 = NPY_CDOUBLE_INIT(0.0, 0.0), tmp2 = NPY_CDOUBLE_INIT(0.0, 0.0), out = NPY_CDOUBLE_INIT(0.0, 0.0); NPY_CDOUBLE_SET_REAL(&tmp1, (double)((float *)ip1)[0]); NPY_CDOUBLE_SET_IMAG(&tmp1, (double)((float *)ip1)[1]); NPY_CDOUBLE_SET_REAL(&tmp2, (double)((float *)ip2)[0]); From bf3fa2121a40948fe4832c94f3260fad1db6a397 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Wed, 5 Jul 2023 19:17:07 +0200 Subject: [PATCH 16/40] Fix implicit declaration of CMPLX on musllinux --- numpy/core/include/numpy/npy_common.h | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index 9925f77e7e7f..775790ccf945 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -406,9 +406,9 @@ typedef std::complex npy_clongdouble; typedef complex double npy_cdouble; typedef complex float npy_cfloat; typedef complex longdouble_t npy_clongdouble; -#define NPY_CDOUBLE_INIT(real, imag) CMPLX(real, imag) -#define NPY_CFLOAT_INIT(real, imag) CMPLXF(real, imag) -#define NPY_CLONGDOUBLE_INIT(real, imag) CMPLXL(real, imag) +#define NPY_CDOUBLE_INIT(real, imag) ((npy_cdouble) ((double) (real) + _Complex_I * (double) (imag))) +#define NPY_CFLOAT_INIT(real, imag) ((npy_cfloat) ((float) (real) + _Complex_I * (float) (imag))) +#define NPY_CLONGDOUBLE_INIT(real, imag) ((npy_clongdouble) ((longdouble_t) (real) + _Complex_I * (longdouble_t) (imag))) #endif #ifndef __cplusplus From 57e204bd430e81a7c24ca391b2758d07a3b5d02d Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Thu, 6 Jul 2023 11:17:31 +0200 Subject: [PATCH 17/40] Hopefully fix Windows stuff --- numpy/core/include/numpy/npy_common.h | 14 +++++++------- numpy/core/src/npymath/npy_math_complex.c.src | 8 +++++++- 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index 775790ccf945..2f89ce4817f4 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -392,16 +392,16 @@ extern "C++" { typedef _Dcomplex npy_cdouble; typedef _Fcomplex npy_cfloat; typedef _Lcomplex npy_clongdouble; -#define NPY_CDOUBLE_INIT(real, imag) _CBuild(real, imag) -#define NPY_CFLOAT_INIT(real, imag) _FCBuild(real, imag) -#define NPY_CLONGDOUBLE_INIT(real, imag) _LCBuild(real, imag) +#define NPY_CDOUBLE_INIT(real, imag) ((npy_cdouble) _Cbuild((double) (real), (double) (imag))) +#define NPY_CFLOAT_INIT(real, imag) ((npy_cfloat) _FCbuild((float) (real), (float) (imag))) +#define NPY_CLONGDOUBLE_INIT(real, imag) ((npy_clongdouble) _LCbuild((longdouble_t) (real), (longdouble_t) (imag))) #elif defined(__cplusplus) /* && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ typedef std::complex npy_cdouble; typedef std::complex npy_cfloat; typedef std::complex npy_clongdouble; -#define NPY_CDOUBLE_INIT(real, imag) std::complex(real, imag) -#define NPY_CFLOAT_INIT(real, imag) std::complex(real, imag) -#define NPY_CLONGDOUBLE_INIT(real, imag) std::complex(real, imag) +#define NPY_CDOUBLE_INIT(real, imag) ((npy_cdouble) std::complex((double) (real), (double) (imag))) +#define NPY_CFLOAT_INIT(real, imag) ((npy_cfloat) std::complex((float) (real), (float) (imag))) +#define NPY_CLONGDOUBLE_INIT(real, imag) ((npy_clongdouble) std::complex((longdouble_t) (real), (longdouble_t) (imag))) #else /* !defined(__cplusplus) && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ typedef complex double npy_cdouble; typedef complex float npy_cfloat; @@ -486,7 +486,7 @@ static inline float NPY_CFLOAT_GET_IMAG(const npy_cfloat *c) { #ifdef __cplusplus return reinterpret_cast(c)[1]; #else - _npy_cdouble_to_arr tmp; + _npy_cfloat_to_arr tmp; tmp.comp = *c; return tmp.arr[1]; #endif diff --git a/numpy/core/src/npymath/npy_math_complex.c.src b/numpy/core/src/npymath/npy_math_complex.c.src index fd181e6671a6..9cb889d3aa1c 100644 --- a/numpy/core/src/npymath/npy_math_complex.c.src +++ b/numpy/core/src/npymath/npy_math_complex.c.src @@ -65,7 +65,13 @@ static const volatile npy_float tiny = 3.9443045e-31f; /*========================================================== * Constants *=========================================================*/ -static const @ctype@ c_1@c@ = NPY_@NAME@_INIT(1.0@C@, 0.0@C@); +#if !defined(__cplusplus) && defined(_MSC_VER) && !defined(__INTEL_COMPILER) +static const @ctype@ c_1@c@ = {1.0@C@, 0.0@C@}; +#elif defined(__cplusplus) +static const @ctype@ c_1@c@ (1.0@C@, 0.0@C@); +#else +static const @ctype@ c_1@c@ = 1.0@C@; +#endif /*========================================================== * Helper functions From c24f998edfc0610bccb79c3881e5091f39d26735 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 7 Jul 2023 11:04:46 +0200 Subject: [PATCH 18/40] Remove cast from INIT macros --- numpy/core/include/numpy/npy_common.h | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index 2f89ce4817f4..e6abc92485c4 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -392,23 +392,23 @@ extern "C++" { typedef _Dcomplex npy_cdouble; typedef _Fcomplex npy_cfloat; typedef _Lcomplex npy_clongdouble; -#define NPY_CDOUBLE_INIT(real, imag) ((npy_cdouble) _Cbuild((double) (real), (double) (imag))) -#define NPY_CFLOAT_INIT(real, imag) ((npy_cfloat) _FCbuild((float) (real), (float) (imag))) -#define NPY_CLONGDOUBLE_INIT(real, imag) ((npy_clongdouble) _LCbuild((longdouble_t) (real), (longdouble_t) (imag))) +#define NPY_CDOUBLE_INIT(real, imag) (_Cbuild((double) (real), (double) (imag))) +#define NPY_CFLOAT_INIT(real, imag) (_FCbuild((float) (real), (float) (imag))) +#define NPY_CLONGDOUBLE_INIT(real, imag) (_LCbuild((longdouble_t) (real), (longdouble_t) (imag))) #elif defined(__cplusplus) /* && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ typedef std::complex npy_cdouble; typedef std::complex npy_cfloat; typedef std::complex npy_clongdouble; -#define NPY_CDOUBLE_INIT(real, imag) ((npy_cdouble) std::complex((double) (real), (double) (imag))) -#define NPY_CFLOAT_INIT(real, imag) ((npy_cfloat) std::complex((float) (real), (float) (imag))) -#define NPY_CLONGDOUBLE_INIT(real, imag) ((npy_clongdouble) std::complex((longdouble_t) (real), (longdouble_t) (imag))) +#define NPY_CDOUBLE_INIT(real, imag) (std::complex((double) (real), (double) (imag))) +#define NPY_CFLOAT_INIT(real, imag) (std::complex((float) (real), (float) (imag))) +#define NPY_CLONGDOUBLE_INIT(real, imag) (std::complex((longdouble_t) (real), (longdouble_t) (imag))) #else /* !defined(__cplusplus) && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ typedef complex double npy_cdouble; typedef complex float npy_cfloat; typedef complex longdouble_t npy_clongdouble; -#define NPY_CDOUBLE_INIT(real, imag) ((npy_cdouble) ((double) (real) + _Complex_I * (double) (imag))) -#define NPY_CFLOAT_INIT(real, imag) ((npy_cfloat) ((float) (real) + _Complex_I * (float) (imag))) -#define NPY_CLONGDOUBLE_INIT(real, imag) ((npy_clongdouble) ((longdouble_t) (real) + _Complex_I * (longdouble_t) (imag))) +#define NPY_CDOUBLE_INIT(real, imag) ((double) (real) + _Complex_I * (double) (imag)) +#define NPY_CFLOAT_INIT(real, imag) ((float) (real) + _Complex_I * (float) (imag)) +#define NPY_CLONGDOUBLE_INIT(real, imag) ((longdouble_t) (real) + _Complex_I * (longdouble_t) (imag)) #endif #ifndef __cplusplus From c38cab641206f869cde8f0efafada3d63133cb72 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 7 Jul 2023 11:14:19 +0200 Subject: [PATCH 19/40] Remove direct complex arithmetic due to Windows --- numpy/core/src/multiarray/arraytypes.c.src | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/numpy/core/src/multiarray/arraytypes.c.src b/numpy/core/src/multiarray/arraytypes.c.src index 21a59771c5c2..af0802aefe6e 100644 --- a/numpy/core/src/multiarray/arraytypes.c.src +++ b/numpy/core/src/multiarray/arraytypes.c.src @@ -3984,8 +3984,13 @@ static int @NAME@_fill(@type@ *buffer, npy_intp length, void *NPY_UNUSED(ignore)) { npy_intp i; - @type@ start = buffer[0]; - @type@ delta = buffer[1] - start; + @type@ start = NPY_@NAME@_INIT(0.0, 0.0); + @type@ delta = NPY_@NAME@_INIT(0.0, 0.0); + + NPY_@NAME@_SET_REAL(&start, NPY_@NAME@_GET_REAL(buffer)); + NPY_@NAME@_SET_IMAG(&start, NPY_@NAME@_GET_IMAG(buffer)); + NPY_@NAME@_SET_REAL(&delta, NPY_@NAME@_GET_REAL(&buffer[1]) - NPY_@NAME@_GET_REAL(&start)); + NPY_@NAME@_SET_IMAG(&delta, NPY_@NAME@_GET_IMAG(&buffer[1]) - NPY_@NAME@_GET_IMAG(&start)); buffer += 2; for (i = 2; i < length; i++, buffer++) { From 5f4ea8a9945c9f6e50dbc300613c01e129482e9f Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 7 Jul 2023 11:34:02 +0200 Subject: [PATCH 20/40] Fix complex init in more places --- numpy/core/src/umath/funcs.inc.src | 6 ++++-- numpy/core/src/umath/matmul.c.src | 14 +++++++++++++- numpy/core/src/umath/scalarmath.c.src | 12 ++++++++---- 3 files changed, 25 insertions(+), 7 deletions(-) diff --git a/numpy/core/src/umath/funcs.inc.src b/numpy/core/src/umath/funcs.inc.src index 79a7c9db20db..bfcc0afe53e0 100644 --- a/numpy/core/src/umath/funcs.inc.src +++ b/numpy/core/src/umath/funcs.inc.src @@ -292,14 +292,16 @@ npy_ObjectClip(PyObject *arr, PyObject *min, PyObject *max) { static void nc_neg@c@(@ctype@ *a, @ctype@ *r) { - *r = -(*a); + NPY_@NAME@_SET_REAL(r, -NPY_@NAME@_GET_REAL(a)); + NPY_@NAME@_SET_IMAG(r, -NPY_@NAME@_GET_IMAG(a)); return; } static void nc_pos@c@(@ctype@ *a, @ctype@ *r) { - *r = +(*a); + NPY_@NAME@_SET_REAL(r, +NPY_@NAME@_GET_REAL(a)); + NPY_@NAME@_SET_IMAG(r, +NPY_@NAME@_GET_IMAG(a)); return; } diff --git a/numpy/core/src/umath/matmul.c.src b/numpy/core/src/umath/matmul.c.src index 64774502f0c7..515a0098c635 100644 --- a/numpy/core/src/umath/matmul.c.src +++ b/numpy/core/src/umath/matmul.c.src @@ -62,8 +62,18 @@ is_blasable2d(npy_intp byte_stride1, npy_intp byte_stride2, return NPY_FALSE; } +#if !defined(__cplusplus) && defined(_MSC_VER) && !defined(__INTEL_COMPILER) +static const npy_cdouble oneD = {1.0, 0.0}, zeroD = {0.0, 0.0}; +static const npy_cfloat oneF = {1.0f, 0.0f}, zeroF = {0.0f, 0.0f}; +#elif defined(__cplusplus) +static const npy_cdouble oneD (1.0, 0.0); +static const npy_cdouble zeroD (0.0, 0.0); +static const npy_cfloat oneF (1.0f, 0.0f); +static const npy_cfloat zeroF (0.0f, 0.0f); +#else static const npy_cdouble oneD = 1.0, zeroD = 0.0; static const npy_cfloat oneF = 1.0f, zeroF = 0.0f; +#endif /**begin repeat * @@ -231,7 +241,9 @@ NPY_NO_EXPORT void for (m = 0; m < dm; m++) { for (p = 0; p < dp; p++) { -#if @IS_HALF@ +#if @IS_COMPLEX@ == 1 + *(@typ@ *)op = NPY_@TYPE@_INIT(0.0, 0.0); +#elif @IS_HALF@ float sum = 0; #else *(@typ@ *)op = 0; diff --git a/numpy/core/src/umath/scalarmath.c.src b/numpy/core/src/umath/scalarmath.c.src index 1d5181d37c8e..ab327a0aac44 100644 --- a/numpy/core/src/umath/scalarmath.c.src +++ b/numpy/core/src/umath/scalarmath.c.src @@ -422,14 +422,16 @@ half_ctype_divmod(npy_half a, npy_half b, npy_half *out1, npy_half *out2) static inline int @name@_ctype_add(@type@ a, @type@ b, @type@ *out) { - *out = a + b; + NPY_@TYPE@_SET_REAL(out, NPY_@TYPE@_GET_REAL(&a) + NPY_@TYPE@_GET_REAL(&b)); + NPY_@TYPE@_SET_IMAG(out, NPY_@TYPE@_GET_IMAG(&a) + NPY_@TYPE@_GET_IMAG(&b)); return 0; } static inline int @name@_ctype_subtract(@type@ a, @type@ b, @type@ *out) { - *out = a - b; + NPY_@TYPE@_SET_REAL(out, NPY_@TYPE@_GET_REAL(&a) - NPY_@TYPE@_GET_REAL(&b)); + NPY_@TYPE@_SET_IMAG(out, NPY_@TYPE@_GET_IMAG(&a) - NPY_@TYPE@_GET_IMAG(&b)); return 0; } @@ -555,7 +557,8 @@ half_ctype_negative(npy_half a, npy_half *out) static inline int @name@_ctype_negative(@type@ a, @type@ *out) { - *out = -a; + NPY_@NAME@_SET_REAL(out, -NPY_@NAME@_GET_REAL(&a)); + NPY_@NAME@_SET_IMAG(out, -NPY_@NAME@_GET_IMAG(&a)); return 0; } /**end repeat**/ @@ -585,7 +588,8 @@ static inline int static inline int @name@_ctype_positive(@type@ a, @type@ *out) { - *out = +a; + NPY_@NAME@_SET_REAL(out, +NPY_@NAME@_GET_REAL(&a)); + NPY_@NAME@_SET_IMAG(out, +NPY_@NAME@_GET_IMAG(&a)); return 0; } From d2e8b412de74fbed03604070181f22b57ae23345 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 7 Jul 2023 12:00:14 +0200 Subject: [PATCH 21/40] Fix complex init in scalarmath --- numpy/core/src/umath/scalarmath.c.src | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/numpy/core/src/umath/scalarmath.c.src b/numpy/core/src/umath/scalarmath.c.src index ab327a0aac44..6882b30046ab 100644 --- a/numpy/core/src/umath/scalarmath.c.src +++ b/numpy/core/src/umath/scalarmath.c.src @@ -1625,13 +1625,31 @@ static PyObject * * Byte, UByte, Short, UShort, Int, UInt, * Long, ULong, LongLong, ULongLong# * + * #ONAME = (BYTE, UBYTE, SHORT, USHORT, INT, UINT, + * LONG, ULONG, LONGLONG, ULONGLONG, + * HALF, FLOAT, DOUBLE, LONGDOUBLE, + * CFLOAT, CDOUBLE, CLONGDOUBLE)*2, + * BYTE, UBYTE, SHORT, USHORT, INT, UINT, + * LONG, ULONG, LONGLONG, ULONGLONG, + * HALF, FLOAT, DOUBLE, LONGDOUBLE, + * FLOAT, DOUBLE, LONGDOUBLE, + * + * BYTE, UBYTE, SHORT, USHORT, INT, UINT, + * LONG, ULONG, LONGLONG, ULONGLONG# + * + * #IS_COMPLEX = 0*14, 1*3, 0*14, 1*3, 0*27# + * * #oper = negative*17, positive*17, absolute*17, invert*10# */ static PyObject * @name@_@oper@(PyObject *a) { @type@ val; +#if @IS_COMPLEX@ == 1 + @otype@ out = NPY_@ONAME@_INIT(0.0, 0.0); +#else @otype@ out; +#endif PyObject *ret; From 0ef48b377da9748c1b591e6ad7f14081722852de Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Mon, 10 Jul 2023 10:59:19 +0200 Subject: [PATCH 22/40] Use latest Cython in CI --- .github/workflows/windows_meson.yml | 2 ++ azure-steps-windows.yml | 5 ++++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/.github/workflows/windows_meson.yml b/.github/workflows/windows_meson.yml index 32c4b9854cfe..b39019829523 100644 --- a/.github/workflows/windows_meson.yml +++ b/.github/workflows/windows_meson.yml @@ -35,6 +35,8 @@ jobs: - name: Install dependencies run: | pip install -r build_requirements.txt + pip uninstall -y cython + pip install git+https://github.com/cython/cython.git@436f8a32ea3a1b0411695db1b974c60434042b5b - name: openblas-libs run: | # Download and install pre-built OpenBLAS library diff --git a/azure-steps-windows.yml b/azure-steps-windows.yml index 1165a9c0f4ee..33bf7fc912f2 100644 --- a/azure-steps-windows.yml +++ b/azure-steps-windows.yml @@ -10,7 +10,10 @@ steps: - script: python -m pip install --upgrade pip wheel displayName: 'Install tools' -- script: python -m pip install -r test_requirements.txt +- script: | + python -m pip install -r test_requirements.txt + python -m pip uninstall -y cython + python -m pip install git+https://github.com/cython/cython.git@436f8a32ea3a1b0411695db1b974c60434042b5b displayName: 'Install dependencies; some are optional to avoid test skips' - powershell: | From c4e9b345c26e657403e91988d7d27893ac26ca30 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Mon, 10 Jul 2023 16:51:00 +0200 Subject: [PATCH 23/40] Change pyproject.toml to build with latest Cython --- pyproject.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pyproject.toml b/pyproject.toml index a983b2704c4a..fca809123141 100644 --- a/pyproject.toml +++ b/pyproject.toml @@ -1,7 +1,7 @@ [build-system] build-backend = "mesonpy" requires = [ - "Cython>=0.29.34", + "Cython @ git+https://github.com/cython/cython.git@436f8a32ea3a1b0411695db1b974c60434042b5b", "meson-python>=0.13.1", ] From e972bc8e07099b9df66b8c4c6316ac5d40c12734 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Wed, 12 Jul 2023 12:32:43 +0200 Subject: [PATCH 24/40] Demote linkage errors to warnings in pyodide build --- .github/workflows/emscripten.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/emscripten.yml b/.github/workflows/emscripten.yml index 3b21364eca91..48061ed6d927 100644 --- a/.github/workflows/emscripten.yml +++ b/.github/workflows/emscripten.yml @@ -59,7 +59,7 @@ jobs: # Pyodide is still in the process of adding better/easier support for # non-setup.py based builds. cp pyproject.toml.setuppy pyproject.toml - CFLAGS=-g2 LDFLAGS=-g2 pyodide build + CFLAGS="-g2 -Wno-error=return-type-c-linkage" LDFLAGS=-g2 pyodide build - name: set up node uses: actions/setup-node@64ed1c7eab4cce3362f8c340dee64e5eaeef8f7c # v3.6.0 From 45b15a12ee6b1742d7da591d254c38d53e00f950 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Wed, 12 Jul 2023 13:44:50 +0200 Subject: [PATCH 25/40] Revert changes to lapack_lite --- numpy/linalg/lapack_lite/f2c.c | 24 +- numpy/linalg/lapack_lite/f2c.h | 24 +- numpy/linalg/lapack_lite/f2c_blas.c | 154 +- numpy/linalg/lapack_lite/f2c_blas.c.patch | 2 +- numpy/linalg/lapack_lite/f2c_c_lapack.c | 1648 ++++++++++----------- numpy/linalg/lapack_lite/f2c_lapack.c | 4 +- 6 files changed, 928 insertions(+), 928 deletions(-) diff --git a/numpy/linalg/lapack_lite/f2c.c b/numpy/linalg/lapack_lite/f2c.c index 47e4d5729b83..ddaa8d17278c 100644 --- a/numpy/linalg/lapack_lite/f2c.c +++ b/numpy/linalg/lapack_lite/f2c.c @@ -93,9 +93,9 @@ return(temp); VOID #ifdef KR_headers -r_cnjg(r, z) singlecomplex *r, *z; +r_cnjg(r, z) complex *r, *z; #else -r_cnjg(singlecomplex *r, singlecomplex *z) +r_cnjg(complex *r, complex *z) #endif { r->r = z->r; @@ -115,9 +115,9 @@ r->i = - z->i; #ifdef KR_headers -float r_imag(z) singlecomplex *z; +float r_imag(z) complex *z; #else -float r_imag(singlecomplex *z) +float r_imag(complex *z) #endif { return(z->i); @@ -343,10 +343,10 @@ void pow_zi(doublecomplex *p, doublecomplex *a, integer *b) /* p = a**b */ #ifdef KR_headers VOID pow_ci(p, a, b) /* p = a**b */ - singlecomplex *p, *a; integer *b; + complex *p, *a; integer *b; #else extern void pow_zi(doublecomplex*, doublecomplex*, integer*); -void pow_ci(singlecomplex *p, singlecomplex *a, integer *b) /* p = a**b */ +void pow_ci(complex *p, complex *a, integer *b) /* p = a**b */ #endif { doublecomplex p1, a1; @@ -536,10 +536,10 @@ int s_copy(register char *a, register char *b, ftnlen la, ftnlen lb) #ifdef KR_headers double f__cabsf(); -double c_abs(z) singlecomplex *z; +double c_abs(z) complex *z; #else double f__cabsf(float, float); -double c_abs(singlecomplex *z) +double c_abs(complex *z) #endif { return( f__cabsf( z->r, z->i ) ); @@ -559,10 +559,10 @@ return( f__cabs( z->r, z->i ) ); #ifdef KR_headers extern void sig_die(); -VOID c_div(c, a, b) singlecomplex *a, *b, *c; +VOID c_div(c, a, b) complex *a, *b, *c; #else extern void sig_die(char*, int); -void c_div(singlecomplex *c, singlecomplex *a, singlecomplex *b) +void c_div(complex *c, complex *a, complex *b) #endif { float ratio, den; @@ -632,12 +632,12 @@ else #ifdef KR_headers float sqrtf(), f__cabsf(); -VOID c_sqrt(r, z) singlecomplex *r, *z; +VOID c_sqrt(r, z) complex *r, *z; #else #undef abs extern double f__cabsf(float, float); -void c_sqrt(singlecomplex *r, singlecomplex *z) +void c_sqrt(complex *r, complex *z) #endif { float mag; diff --git a/numpy/linalg/lapack_lite/f2c.h b/numpy/linalg/lapack_lite/f2c.h index 60bce4a9f575..0db1b9ecb545 100644 --- a/numpy/linalg/lapack_lite/f2c.h +++ b/numpy/linalg/lapack_lite/f2c.h @@ -21,7 +21,7 @@ typedef char *address; typedef short int shortint; typedef float real; typedef double doublereal; -typedef struct { real r, i; } singlecomplex; +typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; typedef CBLAS_INT logical; typedef short int shortlogical; @@ -131,7 +131,7 @@ union Multitype { /* for multiple entry points */ integer i; real r; doublereal d; - singlecomplex c; + complex c; doublecomplex z; }; @@ -234,13 +234,13 @@ extern "C" { #endif extern int abort_(void); -extern double c_abs(singlecomplex *); -extern void c_cos(singlecomplex *, singlecomplex *); -extern void c_div(singlecomplex *, singlecomplex *, singlecomplex *); -extern void c_exp(singlecomplex *, singlecomplex *); -extern void c_log(singlecomplex *, singlecomplex *); -extern void c_sin(singlecomplex *, singlecomplex *); -extern void c_sqrt(singlecomplex *, singlecomplex *); +extern double c_abs(complex *); +extern void c_cos(complex *, complex *); +extern void c_div(complex *, complex *, complex *); +extern void c_exp(complex *, complex *); +extern void c_log(complex *, complex *); +extern void c_sin(complex *, complex *); +extern void c_sqrt(complex *, complex *); extern double d_abs(double *); extern double d_acos(double *); extern double d_asin(double *); @@ -323,7 +323,7 @@ extern ftnlen l_ge(char *, char *, ftnlen, ftnlen); extern ftnlen l_gt(char *, char *, ftnlen, ftnlen); extern ftnlen l_le(char *, char *, ftnlen, ftnlen); extern ftnlen l_lt(char *, char *, ftnlen, ftnlen); -extern void pow_ci(singlecomplex *, singlecomplex *, integer *); +extern void pow_ci(complex *, complex *, integer *); extern double pow_dd(double *, double *); extern double pow_di(double *, integer *); extern short pow_hh(short *, shortint *); @@ -336,12 +336,12 @@ extern double r_acos(float *); extern double r_asin(float *); extern double r_atan(float *); extern double r_atn2(float *, float *); -extern void r_cnjg(singlecomplex *, singlecomplex *); +extern void r_cnjg(complex *, complex *); extern double r_cos(float *); extern double r_cosh(float *); extern double r_dim(float *, float *); extern double r_exp(float *); -extern float r_imag(singlecomplex *); +extern float r_imag(complex *); extern double r_int(float *); extern float r_lg10(real *); extern double r_log(float *); diff --git a/numpy/linalg/lapack_lite/f2c_blas.c b/numpy/linalg/lapack_lite/f2c_blas.c index f8aa5301608b..9a9fd3f9b917 100644 --- a/numpy/linalg/lapack_lite/f2c_blas.c +++ b/numpy/linalg/lapack_lite/f2c_blas.c @@ -29,19 +29,19 @@ them. /* Table of constant values */ -static singlecomplex c_b21 = {1.f,0.f}; +static complex c_b21 = {1.f,0.f}; static doublecomplex c_b1078 = {1.,0.}; -/* Subroutine */ int caxpy_(integer *n, singlecomplex *ca, singlecomplex *cx, integer * - incx, singlecomplex *cy, integer *incy) +/* Subroutine */ int caxpy_(integer *n, complex *ca, complex *cx, integer * + incx, complex *cy, integer *incy) { /* System generated locals */ integer i__1, i__2, i__3, i__4; - singlecomplex q__1, q__2; + complex q__1, q__2; /* Local variables */ static integer i__, ix, iy; - extern doublereal scabs1_(singlecomplex *); + extern doublereal scabs1_(complex *); /* @@ -119,7 +119,7 @@ static doublecomplex c_b1078 = {1.,0.}; return 0; } /* caxpy_ */ -/* Subroutine */ int ccopy_(integer *n, singlecomplex *cx, integer *incx, singlecomplex * +/* Subroutine */ int ccopy_(integer *n, complex *cx, integer *incx, complex * cy, integer *incy) { /* System generated locals */ @@ -193,16 +193,16 @@ static doublecomplex c_b1078 = {1.,0.}; return 0; } /* ccopy_ */ -/* Complex */ VOID cdotc_(singlecomplex * ret_val, integer *n, singlecomplex *cx, integer - *incx, singlecomplex *cy, integer *incy) +/* Complex */ VOID cdotc_(complex * ret_val, integer *n, complex *cx, integer + *incx, complex *cy, integer *incy) { /* System generated locals */ integer i__1, i__2; - singlecomplex q__1, q__2, q__3; + complex q__1, q__2, q__3; /* Local variables */ static integer i__, ix, iy; - static singlecomplex ctemp; + static complex ctemp; /* @@ -280,16 +280,16 @@ static doublecomplex c_b1078 = {1.,0.}; return ; } /* cdotc_ */ -/* Complex */ VOID cdotu_(singlecomplex * ret_val, integer *n, singlecomplex *cx, integer - *incx, singlecomplex *cy, integer *incy) +/* Complex */ VOID cdotu_(complex * ret_val, integer *n, complex *cx, integer + *incx, complex *cy, integer *incy) { /* System generated locals */ integer i__1, i__2, i__3; - singlecomplex q__1, q__2; + complex q__1, q__2; /* Local variables */ static integer i__, ix, iy; - static singlecomplex ctemp; + static complex ctemp; /* @@ -367,18 +367,18 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cdotu_ */ /* Subroutine */ int cgemm_(char *transa, char *transb, integer *m, integer * - n, integer *k, singlecomplex *alpha, singlecomplex *a, integer *lda, singlecomplex *b, - integer *ldb, singlecomplex *beta, singlecomplex *c__, integer *ldc) + n, integer *k, complex *alpha, complex *a, integer *lda, complex *b, + integer *ldb, complex *beta, complex *c__, integer *ldc) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6; - singlecomplex q__1, q__2, q__3, q__4; + complex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__, j, l, info; static logical nota, notb; - static singlecomplex temp; + static complex temp; static logical conja, conjb; extern logical lsame_(char *, char *); static integer nrowa, nrowb; @@ -1034,17 +1034,17 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cgemm_ */ -/* Subroutine */ int cgemv_(char *trans, integer *m, integer *n, singlecomplex * - alpha, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx, singlecomplex * - beta, singlecomplex *y, integer *incy) +/* Subroutine */ int cgemv_(char *trans, integer *m, integer *n, complex * + alpha, complex *a, integer *lda, complex *x, integer *incx, complex * + beta, complex *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - singlecomplex q__1, q__2, q__3; + complex q__1, q__2, q__3; /* Local variables */ static integer i__, j, ix, iy, jx, jy, kx, ky, info; - static singlecomplex temp; + static complex temp; static integer lenx, leny; extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); @@ -1423,16 +1423,16 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cgemv_ */ -/* Subroutine */ int cgerc_(integer *m, integer *n, singlecomplex *alpha, singlecomplex * - x, integer *incx, singlecomplex *y, integer *incy, singlecomplex *a, integer *lda) +/* Subroutine */ int cgerc_(integer *m, integer *n, complex *alpha, complex * + x, integer *incx, complex *y, integer *incy, complex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - singlecomplex q__1, q__2; + complex q__1, q__2; /* Local variables */ static integer i__, j, ix, jy, kx, info; - static singlecomplex temp; + static complex temp; extern /* Subroutine */ int xerbla_(char *, integer *); @@ -1618,16 +1618,16 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cgerc_ */ -/* Subroutine */ int cgeru_(integer *m, integer *n, singlecomplex *alpha, singlecomplex * - x, integer *incx, singlecomplex *y, integer *incy, singlecomplex *a, integer *lda) +/* Subroutine */ int cgeru_(integer *m, integer *n, complex *alpha, complex * + x, integer *incx, complex *y, integer *incy, complex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - singlecomplex q__1, q__2; + complex q__1, q__2; /* Local variables */ static integer i__, j, ix, jy, kx, info; - static singlecomplex temp; + static complex temp; extern /* Subroutine */ int xerbla_(char *, integer *); @@ -1813,18 +1813,18 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cgeru_ */ -/* Subroutine */ int chemv_(char *uplo, integer *n, singlecomplex *alpha, singlecomplex * - a, integer *lda, singlecomplex *x, integer *incx, singlecomplex *beta, singlecomplex *y, +/* Subroutine */ int chemv_(char *uplo, integer *n, complex *alpha, complex * + a, integer *lda, complex *x, integer *incx, complex *beta, complex *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; real r__1; - singlecomplex q__1, q__2, q__3, q__4; + complex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__, j, ix, iy, jx, jy, kx, ky, info; - static singlecomplex temp1, temp2; + static complex temp1, temp2; extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); @@ -2222,17 +2222,17 @@ static doublecomplex c_b1078 = {1.,0.}; } /* chemv_ */ -/* Subroutine */ int cher2_(char *uplo, integer *n, singlecomplex *alpha, singlecomplex * - x, integer *incx, singlecomplex *y, integer *incy, singlecomplex *a, integer *lda) +/* Subroutine */ int cher2_(char *uplo, integer *n, complex *alpha, complex * + x, integer *incx, complex *y, integer *incy, complex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6; real r__1; - singlecomplex q__1, q__2, q__3, q__4; + complex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__, j, ix, iy, jx, jy, kx, ky, info; - static singlecomplex temp1, temp2; + static complex temp1, temp2; extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); @@ -2647,18 +2647,18 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cher2_ */ /* Subroutine */ int cher2k_(char *uplo, char *trans, integer *n, integer *k, - singlecomplex *alpha, singlecomplex *a, integer *lda, singlecomplex *b, integer *ldb, - real *beta, singlecomplex *c__, integer *ldc) + complex *alpha, complex *a, integer *lda, complex *b, integer *ldb, + real *beta, complex *c__, integer *ldc) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; real r__1; - singlecomplex q__1, q__2, q__3, q__4, q__5, q__6; + complex q__1, q__2, q__3, q__4, q__5, q__6; /* Local variables */ static integer i__, j, l, info; - static singlecomplex temp1, temp2; + static complex temp1, temp2; extern logical lsame_(char *, char *); static integer nrowa; static logical upper; @@ -3296,18 +3296,18 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cher2k_ */ /* Subroutine */ int cherk_(char *uplo, char *trans, integer *n, integer *k, - real *alpha, singlecomplex *a, integer *lda, real *beta, singlecomplex *c__, + real *alpha, complex *a, integer *lda, real *beta, complex *c__, integer *ldc) { /* System generated locals */ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6; real r__1; - singlecomplex q__1, q__2, q__3; + complex q__1, q__2, q__3; /* Local variables */ static integer i__, j, l, info; - static singlecomplex temp; + static complex temp; extern logical lsame_(char *, char *); static integer nrowa; static real rtemp; @@ -3802,12 +3802,12 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cherk_ */ -/* Subroutine */ int cscal_(integer *n, singlecomplex *ca, singlecomplex *cx, integer * +/* Subroutine */ int cscal_(integer *n, complex *ca, complex *cx, integer * incx) { /* System generated locals */ integer i__1, i__2, i__3, i__4; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, nincx; @@ -3870,16 +3870,16 @@ static doublecomplex c_b1078 = {1.,0.}; return 0; } /* cscal_ */ -/* Subroutine */ int csrot_(integer *n, singlecomplex *cx, integer *incx, singlecomplex * +/* Subroutine */ int csrot_(integer *n, complex *cx, integer *incx, complex * cy, integer *incy, real *c__, real *s) { /* System generated locals */ integer i__1, i__2, i__3, i__4; - singlecomplex q__1, q__2, q__3; + complex q__1, q__2, q__3; /* Local variables */ static integer i__, ix, iy; - static singlecomplex ctemp; + static complex ctemp; /* @@ -3887,7 +3887,7 @@ static doublecomplex c_b1078 = {1.,0.}; ======= CSROT applies a plane rotation, where the cos and sin (c and s) are real - and the vectors cx and cy are singlecomplex. + and the vectors cx and cy are complex. jack dongarra, linpack, 3/11/78. Arguments @@ -4005,12 +4005,12 @@ static doublecomplex c_b1078 = {1.,0.}; return 0; } /* csrot_ */ -/* Subroutine */ int csscal_(integer *n, real *sa, singlecomplex *cx, integer *incx) +/* Subroutine */ int csscal_(integer *n, real *sa, complex *cx, integer *incx) { /* System generated locals */ integer i__1, i__2, i__3, i__4; real r__1, r__2; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, nincx; @@ -4020,7 +4020,7 @@ static doublecomplex c_b1078 = {1.,0.}; Purpose ======= - CSSCAL scales a singlecomplex vector by a real constant. + CSSCAL scales a complex vector by a real constant. Further Details =============== @@ -4075,7 +4075,7 @@ static doublecomplex c_b1078 = {1.,0.}; return 0; } /* csscal_ */ -/* Subroutine */ int cswap_(integer *n, singlecomplex *cx, integer *incx, singlecomplex * +/* Subroutine */ int cswap_(integer *n, complex *cx, integer *incx, complex * cy, integer *incy) { /* System generated locals */ @@ -4083,7 +4083,7 @@ static doublecomplex c_b1078 = {1.,0.}; /* Local variables */ static integer i__, ix, iy; - static singlecomplex ctemp; + static complex ctemp; /* @@ -4158,17 +4158,17 @@ static doublecomplex c_b1078 = {1.,0.}; } /* cswap_ */ /* Subroutine */ int ctrmm_(char *side, char *uplo, char *transa, char *diag, - integer *m, integer *n, singlecomplex *alpha, singlecomplex *a, integer *lda, - singlecomplex *b, integer *ldb) + integer *m, integer *n, complex *alpha, complex *a, integer *lda, + complex *b, integer *ldb) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5, i__6; - singlecomplex q__1, q__2, q__3; + complex q__1, q__2, q__3; /* Local variables */ static integer i__, j, k, info; - static singlecomplex temp; + static complex temp; extern logical lsame_(char *, char *); static logical lside; static integer nrowa; @@ -4820,15 +4820,15 @@ static doublecomplex c_b1078 = {1.,0.}; } /* ctrmm_ */ /* Subroutine */ int ctrmv_(char *uplo, char *trans, char *diag, integer *n, - singlecomplex *a, integer *lda, singlecomplex *x, integer *incx) + complex *a, integer *lda, complex *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - singlecomplex q__1, q__2, q__3; + complex q__1, q__2, q__3; /* Local variables */ static integer i__, j, ix, jx, kx, info; - static singlecomplex temp; + static complex temp; extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); static logical noconj, nounit; @@ -5352,17 +5352,17 @@ static doublecomplex c_b1078 = {1.,0.}; } /* ctrmv_ */ /* Subroutine */ int ctrsm_(char *side, char *uplo, char *transa, char *diag, - integer *m, integer *n, singlecomplex *alpha, singlecomplex *a, integer *lda, - singlecomplex *b, integer *ldb) + integer *m, integer *n, complex *alpha, complex *a, integer *lda, + complex *b, integer *ldb) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; - singlecomplex q__1, q__2, q__3; + complex q__1, q__2, q__3; /* Local variables */ static integer i__, j, k, info; - static singlecomplex temp; + static complex temp; extern logical lsame_(char *, char *); static logical lside; static integer nrowa; @@ -6024,15 +6024,15 @@ static doublecomplex c_b1078 = {1.,0.}; } /* ctrsm_ */ /* Subroutine */ int ctrsv_(char *uplo, char *trans, char *diag, integer *n, - singlecomplex *a, integer *lda, singlecomplex *x, integer *incx) + complex *a, integer *lda, complex *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - singlecomplex q__1, q__2, q__3; + complex q__1, q__2, q__3; /* Local variables */ static integer i__, j, ix, jx, kx, info; - static singlecomplex temp; + static complex temp; extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); static logical noconj, nounit; @@ -10658,7 +10658,7 @@ doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx) } /* dznrm2_ */ -integer icamax_(integer *n, singlecomplex *cx, integer *incx) +integer icamax_(integer *n, complex *cx, integer *incx) { /* System generated locals */ integer ret_val, i__1; @@ -10666,7 +10666,7 @@ integer icamax_(integer *n, singlecomplex *cx, integer *incx) /* Local variables */ static integer i__, ix; static real smax; - extern doublereal scabs1_(singlecomplex *); + extern doublereal scabs1_(complex *); /* @@ -11066,7 +11066,7 @@ integer izamax_(integer *n, doublecomplex *zx, integer *incx) return 0; } /* saxpy_ */ -doublereal scabs1_(singlecomplex *z__) +doublereal scabs1_(complex *z__) { /* System generated locals */ real ret_val, r__1, r__2; @@ -11085,7 +11085,7 @@ doublereal scabs1_(singlecomplex *z__) return ret_val; } /* scabs1_ */ -doublereal scasum_(integer *n, singlecomplex *cx, integer *incx) +doublereal scasum_(integer *n, complex *cx, integer *incx) { /* System generated locals */ integer i__1, i__2, i__3; @@ -11100,7 +11100,7 @@ doublereal scasum_(integer *n, singlecomplex *cx, integer *incx) Purpose ======= - SCASUM takes the sum of the absolute values of a singlecomplex vector and + SCASUM takes the sum of the absolute values of a complex vector and returns a single precision result. Further Details @@ -11154,7 +11154,7 @@ doublereal scasum_(integer *n, singlecomplex *cx, integer *incx) return ret_val; } /* scasum_ */ -doublereal scnrm2_(integer *n, singlecomplex *x, integer *incx) +doublereal scnrm2_(integer *n, complex *x, integer *incx) { /* System generated locals */ integer i__1, i__2, i__3; diff --git a/numpy/linalg/lapack_lite/f2c_blas.c.patch b/numpy/linalg/lapack_lite/f2c_blas.c.patch index 4ba3fe3cc66b..59a6a1919b11 100644 --- a/numpy/linalg/lapack_lite/f2c_blas.c.patch +++ b/numpy/linalg/lapack_lite/f2c_blas.c.patch @@ -1,6 +1,6 @@ @@ -380,7 +380,6 @@ L20: static logical nota, notb; - static singlecomplex temp; + static complex temp; static logical conja, conjb; - static integer ncola; extern logical lsame_(char *, char *); diff --git a/numpy/linalg/lapack_lite/f2c_c_lapack.c b/numpy/linalg/lapack_lite/f2c_c_lapack.c index 5d456609bdf7..a7d1f836b613 100644 --- a/numpy/linalg/lapack_lite/f2c_c_lapack.c +++ b/numpy/linalg/lapack_lite/f2c_c_lapack.c @@ -30,8 +30,8 @@ them. /* Table of constant values */ static integer c__1 = 1; -static singlecomplex c_b56 = {0.f,0.f}; -static singlecomplex c_b57 = {1.f,0.f}; +static complex c_b56 = {0.f,0.f}; +static complex c_b57 = {1.f,0.f}; static integer c_n1 = -1; static integer c__3 = 3; static integer c__2 = 2; @@ -53,7 +53,7 @@ static logical c_true = TRUE_; static real c_b2435 = .5f; /* Subroutine */ int cgebak_(char *job, char *side, integer *n, integer *ilo, - integer *ihi, real *scale, integer *m, singlecomplex *v, integer *ldv, + integer *ihi, real *scale, integer *m, complex *v, integer *ldv, integer *info) { /* System generated locals */ @@ -64,10 +64,10 @@ static real c_b2435 = .5f; static real s; static integer ii; extern logical lsame_(char *, char *); - extern /* Subroutine */ int cswap_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *); + extern /* Subroutine */ int cswap_(integer *, complex *, integer *, + complex *, integer *); static logical leftv; - extern /* Subroutine */ int csscal_(integer *, real *, singlecomplex *, integer + extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); static logical rightv; @@ -82,7 +82,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEBAK forms the right or left eigenvectors of a singlecomplex general + CGEBAK forms the right or left eigenvectors of a complex general matrix by backward transformation on the computed eigenvectors of the balanced matrix output by CGEBAL. @@ -264,7 +264,7 @@ static real c_b2435 = .5f; } /* cgebak_ */ -/* Subroutine */ int cgebal_(char *job, integer *n, singlecomplex *a, integer *lda, +/* Subroutine */ int cgebal_(char *job, integer *n, complex *a, integer *lda, integer *ilo, integer *ihi, real *scale, integer *info) { /* System generated locals */ @@ -277,12 +277,12 @@ static real c_b2435 = .5f; static real r__, s, ca, ra; static integer ica, ira, iexc; extern logical lsame_(char *, char *); - extern /* Subroutine */ int cswap_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *); + extern /* Subroutine */ int cswap_(integer *, complex *, integer *, + complex *, integer *); static real sfmin1, sfmin2, sfmax1, sfmax2; - extern integer icamax_(integer *, singlecomplex *, integer *); + extern integer icamax_(integer *, complex *, integer *); extern doublereal slamch_(char *); - extern /* Subroutine */ int csscal_(integer *, real *, singlecomplex *, integer + extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); extern logical sisnan_(real *); static logical noconv; @@ -298,7 +298,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEBAL balances a general singlecomplex matrix A. This involves, first, + CGEBAL balances a general complex matrix A. This involves, first, permuting A by a similarity transformation to isolate eigenvalues in the first 1 to ILO-1 and last IHI+1 to N elements on the diagonal; and second, applying a diagonal similarity transformation @@ -654,21 +654,21 @@ static real c_b2435 = .5f; } /* cgebal_ */ -/* Subroutine */ int cgebd2_(integer *m, integer *n, singlecomplex *a, integer *lda, - real *d__, real *e, singlecomplex *tauq, singlecomplex *taup, singlecomplex *work, +/* Subroutine */ int cgebd2_(integer *m, integer *n, complex *a, integer *lda, + real *d__, real *e, complex *tauq, complex *taup, complex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__; - static singlecomplex alpha; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * - , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), - clarfg_(integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), - clacgv_(integer *, singlecomplex *, integer *), xerbla_(char *, integer + static complex alpha; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * + , integer *, complex *, complex *, integer *, complex *), + clarfg_(integer *, complex *, complex *, integer *, complex *), + clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); @@ -682,7 +682,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEBD2 reduces a singlecomplex general m by n matrix A to upper or lower + CGEBD2 reduces a complex general m by n matrix A to upper or lower real bidiagonal form B by a unitary transformation: Q' * A * P = B. If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. @@ -755,7 +755,7 @@ static real c_b2435 = .5f; H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' - where tauq and taup are singlecomplex scalars, and v and u are singlecomplex + where tauq and taup are complex scalars, and v and u are complex vectors; v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n); tauq is stored in TAUQ(i) and taup in TAUP(i). @@ -768,7 +768,7 @@ static real c_b2435 = .5f; H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' - where tauq and taup are singlecomplex scalars, v and u are singlecomplex vectors; + where tauq and taup are complex scalars, v and u are complex vectors; v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i). @@ -972,27 +972,27 @@ static real c_b2435 = .5f; } /* cgebd2_ */ -/* Subroutine */ int cgebrd_(integer *m, integer *n, singlecomplex *a, integer *lda, - real *d__, real *e, singlecomplex *tauq, singlecomplex *taup, singlecomplex *work, +/* Subroutine */ int cgebrd_(integer *m, integer *n, complex *a, integer *lda, + real *d__, real *e, complex *tauq, complex *taup, complex *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; real r__1; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, j, nb, nx; static real ws; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *); + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *); static integer nbmin, iinfo, minmn; - extern /* Subroutine */ int cgebd2_(integer *, integer *, singlecomplex *, - integer *, real *, real *, singlecomplex *, singlecomplex *, singlecomplex *, - integer *), clabrd_(integer *, integer *, integer *, singlecomplex *, - integer *, real *, real *, singlecomplex *, singlecomplex *, singlecomplex *, - integer *, singlecomplex *, integer *), xerbla_(char *, integer *); + extern /* Subroutine */ int cgebd2_(integer *, integer *, complex *, + integer *, real *, real *, complex *, complex *, complex *, + integer *), clabrd_(integer *, integer *, integer *, complex *, + integer *, real *, real *, complex *, complex *, complex *, + integer *, complex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static integer ldwrkx, ldwrky, lwkopt; @@ -1009,7 +1009,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEBRD reduces a general singlecomplex M-by-N matrix A to upper or lower + CGEBRD reduces a general complex M-by-N matrix A to upper or lower bidiagonal form B by a unitary transformation: Q**H * A * P = B. If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. @@ -1093,7 +1093,7 @@ static real c_b2435 = .5f; H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' - where tauq and taup are singlecomplex scalars, and v and u are singlecomplex + where tauq and taup are complex scalars, and v and u are complex vectors; v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n); tauq is stored in TAUQ(i) and taup in TAUP(i). @@ -1106,7 +1106,7 @@ static real c_b2435 = .5f; H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' - where tauq and taup are singlecomplex scalars, and v and u are singlecomplex + where tauq and taup are complex scalars, and v and u are complex vectors; v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i). @@ -1297,59 +1297,59 @@ static real c_b2435 = .5f; } /* cgebrd_ */ -/* Subroutine */ int cgeev_(char *jobvl, char *jobvr, integer *n, singlecomplex *a, - integer *lda, singlecomplex *w, singlecomplex *vl, integer *ldvl, singlecomplex *vr, - integer *ldvr, singlecomplex *work, integer *lwork, real *rwork, integer * +/* Subroutine */ int cgeev_(char *jobvl, char *jobvr, integer *n, complex *a, + integer *lda, complex *w, complex *vl, integer *ldvl, complex *vr, + integer *ldvr, complex *work, integer *lwork, real *rwork, integer * info) { /* System generated locals */ integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3; real r__1, r__2; - singlecomplex q__1, q__2; + complex q__1, q__2; /* Local variables */ static integer i__, k, ihi; static real scl; static integer ilo; static real dum[1], eps; - static singlecomplex tmp; + static complex tmp; static integer ibal; static char side[1]; static real anrm; static integer ierr, itau, iwrk, nout; - extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, + extern /* Subroutine */ int cscal_(integer *, complex *, complex *, integer *); extern logical lsame_(char *, char *); - extern doublereal scnrm2_(integer *, singlecomplex *, integer *); + extern doublereal scnrm2_(integer *, complex *, integer *); extern /* Subroutine */ int cgebak_(char *, char *, integer *, integer *, - integer *, real *, integer *, singlecomplex *, integer *, integer *), cgebal_(char *, integer *, singlecomplex *, integer *, + integer *, real *, integer *, complex *, integer *, integer *), cgebal_(char *, integer *, complex *, integer *, integer *, integer *, real *, integer *), slabad_(real *, real *); static logical scalea; - extern doublereal clange_(char *, integer *, integer *, singlecomplex *, + extern doublereal clange_(char *, integer *, integer *, complex *, integer *, real *); static real cscale; extern /* Subroutine */ int cgehrd_(integer *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer *), + complex *, integer *, complex *, complex *, integer *, integer *), clascl_(char *, integer *, integer *, real *, real *, integer *, - integer *, singlecomplex *, integer *, integer *); + integer *, complex *, integer *, integer *); extern doublereal slamch_(char *); - extern /* Subroutine */ int csscal_(integer *, real *, singlecomplex *, integer - *), clacpy_(char *, integer *, integer *, singlecomplex *, integer *, - singlecomplex *, integer *), xerbla_(char *, integer *); + extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer + *), clacpy_(char *, integer *, integer *, complex *, integer *, + complex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static logical select[1]; static real bignum; extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ int chseqr_(char *, char *, integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *, integer *), ctrevc_(char *, - char *, logical *, integer *, singlecomplex *, integer *, singlecomplex *, - integer *, singlecomplex *, integer *, integer *, integer *, singlecomplex *, + integer *, complex *, integer *, complex *, complex *, integer *, + complex *, integer *, integer *), ctrevc_(char *, + char *, logical *, integer *, complex *, integer *, complex *, + integer *, complex *, integer *, integer *, integer *, complex *, real *, integer *), cunghr_(integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, + integer *, complex *, integer *, complex *, complex *, integer *, integer *); static integer minwrk, maxwrk; static logical wantvl; @@ -1368,7 +1368,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEEV computes for an N-by-N singlecomplex nonsymmetric matrix A, the + CGEEV computes for an N-by-N complex nonsymmetric matrix A, the eigenvalues and, optionally, the left and/or right eigenvectors. The right eigenvector v(j) of A satisfies @@ -1493,7 +1493,7 @@ static real c_b2435 = .5f; (Note: Comments in the code beginning "Workspace:" describe the minimal amount of workspace needed at that point in the code, as well as the preferred amount for good performance. - CWorkspace refers to singlecomplex workspace, and RWorkspace to real + CWorkspace refers to complex workspace, and RWorkspace to real workspace. NB refers to the optimal block size for the immediately following subroutine, as returned by ILAENV. HSWORK refers to the workspace preferred by CHSEQR, as @@ -1816,19 +1816,19 @@ static real c_b2435 = .5f; } /* cgeev_ */ -/* Subroutine */ int cgehd2_(integer *n, integer *ilo, integer *ihi, singlecomplex * - a, integer *lda, singlecomplex *tau, singlecomplex *work, integer *info) +/* Subroutine */ int cgehd2_(integer *n, integer *ilo, integer *ihi, complex * + a, integer *lda, complex *tau, complex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__; - static singlecomplex alpha; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * - , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), - clarfg_(integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), + static complex alpha; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * + , integer *, complex *, complex *, integer *, complex *), + clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); @@ -1842,7 +1842,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEHD2 reduces a singlecomplex general matrix A to upper Hessenberg form H + CGEHD2 reduces a complex general matrix A to upper Hessenberg form H by a unitary similarity transformation: Q' * A * Q = H . Arguments @@ -1892,7 +1892,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on exit in A(i+2:ihi,i), and tau in TAU(i). @@ -1983,34 +1983,34 @@ static real c_b2435 = .5f; } /* cgehd2_ */ -/* Subroutine */ int cgehrd_(integer *n, integer *ilo, integer *ihi, singlecomplex * - a, integer *lda, singlecomplex *tau, singlecomplex *work, integer *lwork, integer +/* Subroutine */ int cgehrd_(integer *n, integer *ilo, integer *ihi, complex * + a, integer *lda, complex *tau, complex *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, j; - static singlecomplex t[4160] /* was [65][64] */; + static complex t[4160] /* was [65][64] */; static integer ib; - static singlecomplex ei; + static complex ei; static integer nb, nh, nx, iws; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *); + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *); static integer nbmin, iinfo; extern /* Subroutine */ int ctrmm_(char *, char *, char *, char *, - integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, + integer *, integer *, complex *, complex *, integer *, complex *, integer *), caxpy_(integer *, - singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *), cgehd2_( - integer *, integer *, integer *, singlecomplex *, integer *, singlecomplex *, - singlecomplex *, integer *), clahr2_(integer *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, + complex *, complex *, integer *, complex *, integer *), cgehd2_( + integer *, integer *, integer *, complex *, integer *, complex *, + complex *, integer *), clahr2_(integer *, integer *, integer *, + complex *, integer *, complex *, complex *, integer *, complex *, integer *), clarfb_(char *, char *, char *, char *, integer *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, - singlecomplex *, integer *, singlecomplex *, integer *), xerbla_(char *, integer *); + integer *, integer *, complex *, integer *, complex *, integer *, + complex *, integer *, complex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static integer ldwork, lwkopt; @@ -2027,7 +2027,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEHRD reduces a singlecomplex general matrix A to upper Hessenberg form H by + CGEHRD reduces a complex general matrix A to upper Hessenberg form H by an unitary similarity transformation: Q' * A * Q = H . Arguments @@ -2089,7 +2089,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on exit in A(i+2:ihi,i), and tau in TAU(i). @@ -2313,19 +2313,19 @@ static real c_b2435 = .5f; } /* cgehrd_ */ -/* Subroutine */ int cgelq2_(integer *m, integer *n, singlecomplex *a, integer *lda, - singlecomplex *tau, singlecomplex *work, integer *info) +/* Subroutine */ int cgelq2_(integer *m, integer *n, complex *a, integer *lda, + complex *tau, complex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; /* Local variables */ static integer i__, k; - static singlecomplex alpha; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * - , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), - clarfg_(integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), - clacgv_(integer *, singlecomplex *, integer *), xerbla_(char *, integer + static complex alpha; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * + , integer *, complex *, complex *, integer *, complex *), + clarfg_(integer *, complex *, complex *, integer *, complex *), + clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); @@ -2339,7 +2339,7 @@ static real c_b2435 = .5f; Purpose ======= - CGELQ2 computes an LQ factorization of a singlecomplex m by n matrix A: + CGELQ2 computes an LQ factorization of a complex m by n matrix A: A = L * Q. Arguments @@ -2383,7 +2383,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in A(i,i+1:n), and tau in TAU(i). @@ -2454,20 +2454,20 @@ static real c_b2435 = .5f; } /* cgelq2_ */ -/* Subroutine */ int cgelqf_(integer *m, integer *n, singlecomplex *a, integer *lda, - singlecomplex *tau, singlecomplex *work, integer *lwork, integer *info) +/* Subroutine */ int cgelqf_(integer *m, integer *n, complex *a, integer *lda, + complex *tau, complex *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; /* Local variables */ static integer i__, k, ib, nb, nx, iws, nbmin, iinfo; - extern /* Subroutine */ int cgelq2_(integer *, integer *, singlecomplex *, - integer *, singlecomplex *, singlecomplex *, integer *), clarfb_(char *, char - *, char *, char *, integer *, integer *, integer *, singlecomplex *, - integer *, singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, + extern /* Subroutine */ int cgelq2_(integer *, integer *, complex *, + integer *, complex *, complex *, integer *), clarfb_(char *, char + *, char *, char *, integer *, integer *, integer *, complex *, + integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char * - , integer *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * + , integer *, integer *, complex *, integer *, complex *, complex * , integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -2485,7 +2485,7 @@ static real c_b2435 = .5f; Purpose ======= - CGELQF computes an LQ factorization of a singlecomplex M-by-N matrix A: + CGELQF computes an LQ factorization of a complex M-by-N matrix A: A = L * Q. Arguments @@ -2540,7 +2540,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(1:i-1) = 0 and v(i) = 1; conjg(v(i+1:n)) is stored on exit in A(i,i+1:n), and tau in TAU(i). @@ -2685,9 +2685,9 @@ static real c_b2435 = .5f; } /* cgelqf_ */ -/* Subroutine */ int cgelsd_(integer *m, integer *n, integer *nrhs, singlecomplex * - a, integer *lda, singlecomplex *b, integer *ldb, real *s, real *rcond, - integer *rank, singlecomplex *work, integer *lwork, real *rwork, integer * +/* Subroutine */ int cgelsd_(integer *m, integer *n, integer *nrhs, complex * + a, integer *lda, complex *b, integer *ldb, real *s, real *rcond, + integer *rank, complex *work, integer *lwork, real *rwork, integer * iwork, integer *info) { /* System generated locals */ @@ -2699,36 +2699,36 @@ static real c_b2435 = .5f; static integer itau, nlvl, iascl, ibscl; static real sfmin; static integer minmn, maxmn, itaup, itauq, mnthr, nwork; - extern /* Subroutine */ int cgebrd_(integer *, integer *, singlecomplex *, - integer *, real *, real *, singlecomplex *, singlecomplex *, singlecomplex *, + extern /* Subroutine */ int cgebrd_(integer *, integer *, complex *, + integer *, real *, real *, complex *, complex *, complex *, integer *, integer *), slabad_(real *, real *); - extern doublereal clange_(char *, integer *, integer *, singlecomplex *, + extern doublereal clange_(char *, integer *, integer *, complex *, integer *, real *); - extern /* Subroutine */ int cgelqf_(integer *, integer *, singlecomplex *, - integer *, singlecomplex *, singlecomplex *, integer *, integer *), clalsd_( - char *, integer *, integer *, integer *, real *, real *, singlecomplex * - , integer *, real *, integer *, singlecomplex *, real *, integer *, + extern /* Subroutine */ int cgelqf_(integer *, integer *, complex *, + integer *, complex *, complex *, integer *, integer *), clalsd_( + char *, integer *, integer *, integer *, real *, real *, complex * + , integer *, real *, integer *, complex *, real *, integer *, integer *), clascl_(char *, integer *, integer *, real *, - real *, integer *, integer *, singlecomplex *, integer *, integer *), cgeqrf_(integer *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *, integer *); + real *, integer *, integer *, complex *, integer *, integer *), cgeqrf_(integer *, integer *, complex *, integer *, + complex *, complex *, integer *, integer *); extern doublereal slamch_(char *); - extern /* Subroutine */ int clacpy_(char *, integer *, integer *, singlecomplex - *, integer *, singlecomplex *, integer *), claset_(char *, - integer *, integer *, singlecomplex *, singlecomplex *, singlecomplex *, integer *), xerbla_(char *, integer *); + extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex + *, integer *, complex *, integer *), claset_(char *, + integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), cunmbr_(char *, char *, char *, integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *, integer *), slaset_( + integer *, complex *, integer *, complex *, complex *, integer *, + complex *, integer *, integer *), slaset_( char *, integer *, integer *, real *, real *, real *, integer *), cunmlq_(char *, char *, integer *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, + complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); static integer ldwork; extern /* Subroutine */ int cunmqr_(char *, char *, integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *, integer *); + integer *, complex *, integer *, complex *, complex *, integer *, + complex *, integer *, integer *); static integer liwork, minwrk, maxwrk; static real smlnum; static integer lrwork; @@ -3416,19 +3416,19 @@ static real c_b2435 = .5f; } /* cgelsd_ */ -/* Subroutine */ int cgeqr2_(integer *m, integer *n, singlecomplex *a, integer *lda, - singlecomplex *tau, singlecomplex *work, integer *info) +/* Subroutine */ int cgeqr2_(integer *m, integer *n, complex *a, integer *lda, + complex *tau, complex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, k; - static singlecomplex alpha; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * - , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), - clarfg_(integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), + static complex alpha; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * + , integer *, complex *, complex *, integer *, complex *), + clarfg_(integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); @@ -3442,7 +3442,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEQR2 computes a QR factorization of a singlecomplex m by n matrix A: + CGEQR2 computes a QR factorization of a complex m by n matrix A: A = Q * R. Arguments @@ -3486,7 +3486,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), and tau in TAU(i). @@ -3554,20 +3554,20 @@ static real c_b2435 = .5f; } /* cgeqr2_ */ -/* Subroutine */ int cgeqrf_(integer *m, integer *n, singlecomplex *a, integer *lda, - singlecomplex *tau, singlecomplex *work, integer *lwork, integer *info) +/* Subroutine */ int cgeqrf_(integer *m, integer *n, complex *a, integer *lda, + complex *tau, complex *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; /* Local variables */ static integer i__, k, ib, nb, nx, iws, nbmin, iinfo; - extern /* Subroutine */ int cgeqr2_(integer *, integer *, singlecomplex *, - integer *, singlecomplex *, singlecomplex *, integer *), clarfb_(char *, char - *, char *, char *, integer *, integer *, integer *, singlecomplex *, - integer *, singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, + extern /* Subroutine */ int cgeqr2_(integer *, integer *, complex *, + integer *, complex *, complex *, integer *), clarfb_(char *, char + *, char *, char *, integer *, integer *, integer *, complex *, + integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char * - , integer *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * + , integer *, integer *, complex *, integer *, complex *, complex * , integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -3585,7 +3585,7 @@ static real c_b2435 = .5f; Purpose ======= - CGEQRF computes a QR factorization of a singlecomplex M-by-N matrix A: + CGEQRF computes a QR factorization of a complex M-by-N matrix A: A = Q * R. Arguments @@ -3641,7 +3641,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), and tau in TAU(i). @@ -3786,9 +3786,9 @@ static real c_b2435 = .5f; } /* cgeqrf_ */ -/* Subroutine */ int cgesdd_(char *jobz, integer *m, integer *n, singlecomplex *a, - integer *lda, real *s, singlecomplex *u, integer *ldu, singlecomplex *vt, integer - *ldvt, singlecomplex *work, integer *lwork, real *rwork, integer *iwork, +/* Subroutine */ int cgesdd_(char *jobz, integer *m, integer *n, complex *a, + integer *lda, real *s, complex *u, integer *ldu, complex *vt, integer + *ldvt, complex *work, integer *lwork, real *rwork, integer *iwork, integer *info) { /* System generated locals */ @@ -3802,50 +3802,50 @@ static real c_b2435 = .5f; static real anrm; static integer idum[1], ierr, itau, irvt; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *); + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *); extern logical lsame_(char *, char *); static integer chunk, minmn, wrkbl, itaup, itauq; static logical wntqa; static integer nwork; extern /* Subroutine */ int clacp2_(char *, integer *, integer *, real *, - integer *, singlecomplex *, integer *); + integer *, complex *, integer *); static logical wntqn, wntqo, wntqs; static integer mnthr1, mnthr2; - extern /* Subroutine */ int cgebrd_(integer *, integer *, singlecomplex *, - integer *, real *, real *, singlecomplex *, singlecomplex *, singlecomplex *, + extern /* Subroutine */ int cgebrd_(integer *, integer *, complex *, + integer *, real *, real *, complex *, complex *, complex *, integer *, integer *); - extern doublereal clange_(char *, integer *, integer *, singlecomplex *, + extern doublereal clange_(char *, integer *, integer *, complex *, integer *, real *); - extern /* Subroutine */ int cgelqf_(integer *, integer *, singlecomplex *, - integer *, singlecomplex *, singlecomplex *, integer *, integer *), clacrm_( - integer *, integer *, singlecomplex *, integer *, real *, integer *, - singlecomplex *, integer *, real *), clarcm_(integer *, integer *, real - *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, real *), + extern /* Subroutine */ int cgelqf_(integer *, integer *, complex *, + integer *, complex *, complex *, integer *, integer *), clacrm_( + integer *, integer *, complex *, integer *, real *, integer *, + complex *, integer *, real *), clarcm_(integer *, integer *, real + *, integer *, complex *, integer *, complex *, integer *, real *), clascl_(char *, integer *, integer *, real *, real *, integer *, - integer *, singlecomplex *, integer *, integer *), sbdsdc_(char + integer *, complex *, integer *, integer *), sbdsdc_(char *, char *, integer *, real *, real *, real *, integer *, real *, - integer *, real *, integer *, real *, integer *, integer *), cgeqrf_(integer *, integer *, singlecomplex *, integer - *, singlecomplex *, singlecomplex *, integer *, integer *); + integer *, real *, integer *, real *, integer *, integer *), cgeqrf_(integer *, integer *, complex *, integer + *, complex *, complex *, integer *, integer *); extern doublereal slamch_(char *); - extern /* Subroutine */ int clacpy_(char *, integer *, integer *, singlecomplex - *, integer *, singlecomplex *, integer *), claset_(char *, - integer *, integer *, singlecomplex *, singlecomplex *, singlecomplex *, integer *), xerbla_(char *, integer *); + extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex + *, integer *, complex *, integer *), claset_(char *, + integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int cungbr_(char *, integer *, integer *, integer - *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer + *, complex *, integer *, complex *, complex *, integer *, integer *); static real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), cunmbr_(char *, char *, char *, integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *, integer *), cunglq_( - integer *, integer *, integer *, singlecomplex *, integer *, singlecomplex *, - singlecomplex *, integer *, integer *); + integer *, complex *, integer *, complex *, complex *, integer *, + complex *, integer *, integer *), cunglq_( + integer *, integer *, integer *, complex *, integer *, complex *, + complex *, integer *, integer *); static integer ldwrkl; extern /* Subroutine */ int cungqr_(integer *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer *); + complex *, integer *, complex *, complex *, integer *, integer *); static integer ldwrkr, minwrk, ldwrku, maxwrk, ldwkvt; static real smlnum; static logical wntqas; @@ -3863,7 +3863,7 @@ static real c_b2435 = .5f; Purpose ======= - CGESDD computes the singular value decomposition (SVD) of a singlecomplex + CGESDD computes the singular value decomposition (SVD) of a complex M-by-N matrix A, optionally computing the left and/or right singular vectors, by using divide-and-conquer method. The SVD is written @@ -4041,7 +4041,7 @@ static real c_b2435 = .5f; (Note: Comments in the code beginning "Workspace:" describe the minimal amount of workspace needed at that point in the code, as well as the preferred amount for good performance. - CWorkspace refers to singlecomplex workspace, and RWorkspace to + CWorkspace refers to complex workspace, and RWorkspace to real workspace. NB refers to the optimal block size for the immediately following subroutine, as returned by ILAENV.) */ @@ -4050,7 +4050,7 @@ static real c_b2435 = .5f; if (*m >= *n) { /* - There is no singlecomplex work space needed for bidiagonal SVD + There is no complex work space needed for bidiagonal SVD The real work space needed for bidiagonal SVD is BDSPAC for computing singular values and singular vectors; BDSPAN for computing singular values only. @@ -4243,7 +4243,7 @@ static real c_b2435 = .5f; } else { /* - There is no singlecomplex work space needed for bidiagonal SVD + There is no complex work space needed for bidiagonal SVD The real work space needed for bidiagonal SVD is BDSPAC for computing singular values and singular vectors; BDSPAN for computing singular values only. @@ -4621,7 +4621,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to singlecomplex matrix WORK(IU) + Copy real matrix RWORK(IRU) to complex matrix WORK(IU) Overwrite WORK(IU) by the left singular vectors of R (CWorkspace: need 2*N*N+3*N, prefer M*N+N*N+2*N+N*NB) (RWorkspace: 0) @@ -4634,7 +4634,7 @@ static real c_b2435 = .5f; ierr); /* - Copy real matrix RWORK(IRVT) to singlecomplex matrix VT + Copy real matrix RWORK(IRVT) to complex matrix VT Overwrite VT by the right singular vectors of R (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) (RWorkspace: 0) @@ -4742,7 +4742,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to singlecomplex matrix U + Copy real matrix RWORK(IRU) to complex matrix U Overwrite U by left singular vectors of R (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) (RWorkspace: 0) @@ -4754,7 +4754,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr); /* - Copy real matrix RWORK(IRVT) to singlecomplex matrix VT + Copy real matrix RWORK(IRVT) to complex matrix VT Overwrite VT by right singular vectors of R (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) (RWorkspace: 0) @@ -4851,7 +4851,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to singlecomplex matrix WORK(IU) + Copy real matrix RWORK(IRU) to complex matrix WORK(IU) Overwrite WORK(IU) by left singular vectors of R (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) (RWorkspace: 0) @@ -4864,7 +4864,7 @@ static real c_b2435 = .5f; ierr); /* - Copy real matrix RWORK(IRVT) to singlecomplex matrix VT + Copy real matrix RWORK(IRVT) to complex matrix VT Overwrite VT by right singular vectors of R (CWorkspace: need 3*N, prefer 2*N+N*NB) (RWorkspace: 0) @@ -5202,7 +5202,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRVT) to singlecomplex matrix VT + Copy real matrix RWORK(IRVT) to complex matrix VT Overwrite VT by right singular vectors of A (Cworkspace: need 2*N, prefer N+N*NB) (Rworkspace: need 0) @@ -5217,7 +5217,7 @@ static real c_b2435 = .5f; if (*lwork >= *m * *n + *n * 3) { /* - Copy real matrix RWORK(IRU) to singlecomplex matrix WORK(IU) + Copy real matrix RWORK(IRU) to complex matrix WORK(IU) Overwrite WORK(IU) by left singular vectors of A, copying to A (Cworkspace: need M*N+2*N, prefer M*N+N+N*NB) @@ -5284,7 +5284,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to singlecomplex matrix U + Copy real matrix RWORK(IRU) to complex matrix U Overwrite U by left singular vectors of A (CWorkspace: need 3*N, prefer 2*N+N*NB) (RWorkspace: 0) @@ -5297,7 +5297,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr); /* - Copy real matrix RWORK(IRVT) to singlecomplex matrix VT + Copy real matrix RWORK(IRVT) to complex matrix VT Overwrite VT by right singular vectors of A (CWorkspace: need 3*N, prefer 2*N+N*NB) (RWorkspace: 0) @@ -5336,7 +5336,7 @@ static real c_b2435 = .5f; } /* - Copy real matrix RWORK(IRU) to singlecomplex matrix U + Copy real matrix RWORK(IRU) to complex matrix U Overwrite U by left singular vectors of A (CWorkspace: need 2*N+M, prefer 2*N+M*NB) (RWorkspace: 0) @@ -5348,7 +5348,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr); /* - Copy real matrix RWORK(IRVT) to singlecomplex matrix VT + Copy real matrix RWORK(IRVT) to complex matrix VT Overwrite VT by right singular vectors of A (CWorkspace: need 3*N, prefer 2*N+N*NB) (RWorkspace: 0) @@ -5512,7 +5512,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to singlecomplex matrix WORK(IU) + Copy real matrix RWORK(IRU) to complex matrix WORK(IU) Overwrite WORK(IU) by the left singular vectors of L (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) (RWorkspace: 0) @@ -5524,7 +5524,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__2, &ierr); /* - Copy real matrix RWORK(IRVT) to singlecomplex matrix WORK(IVT) + Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) Overwrite WORK(IVT) by the right singular vectors of L (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) (RWorkspace: 0) @@ -5632,7 +5632,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to singlecomplex matrix U + Copy real matrix RWORK(IRU) to complex matrix U Overwrite U by left singular vectors of L (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) (RWorkspace: 0) @@ -5644,7 +5644,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr); /* - Copy real matrix RWORK(IRVT) to singlecomplex matrix VT + Copy real matrix RWORK(IRVT) to complex matrix VT Overwrite VT by left singular vectors of L (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) (RWorkspace: 0) @@ -5741,7 +5741,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to singlecomplex matrix U + Copy real matrix RWORK(IRU) to complex matrix U Overwrite U by left singular vectors of L (CWorkspace: need 3*M, prefer 2*M+M*NB) (RWorkspace: 0) @@ -5753,7 +5753,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr); /* - Copy real matrix RWORK(IRVT) to singlecomplex matrix WORK(IVT) + Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) Overwrite WORK(IVT) by right singular vectors of L (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) (RWorkspace: 0) @@ -6095,7 +6095,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to singlecomplex matrix U + Copy real matrix RWORK(IRU) to complex matrix U Overwrite U by left singular vectors of A (Cworkspace: need 2*M, prefer M+M*NB) (Rworkspace: need 0) @@ -6109,7 +6109,7 @@ static real c_b2435 = .5f; if (*lwork >= *m * *n + *m * 3) { /* - Copy real matrix RWORK(IRVT) to singlecomplex matrix WORK(IVT) + Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) Overwrite WORK(IVT) by right singular vectors of A, copying to A (Cworkspace: need M*N+2*M, prefer M*N+M+M*NB) @@ -6174,7 +6174,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to singlecomplex matrix U + Copy real matrix RWORK(IRU) to complex matrix U Overwrite U by left singular vectors of A (CWorkspace: need 3*M, prefer 2*M+M*NB) (RWorkspace: M*M) @@ -6186,7 +6186,7 @@ static real c_b2435 = .5f; itauq], &u[u_offset], ldu, &work[nwork], &i__1, &ierr); /* - Copy real matrix RWORK(IRVT) to singlecomplex matrix VT + Copy real matrix RWORK(IRVT) to complex matrix VT Overwrite VT by right singular vectors of A (CWorkspace: need 3*M, prefer 2*M+M*NB) (RWorkspace: M*M) @@ -6217,7 +6217,7 @@ static real c_b2435 = .5f; info); /* - Copy real matrix RWORK(IRU) to singlecomplex matrix U + Copy real matrix RWORK(IRU) to complex matrix U Overwrite U by left singular vectors of A (CWorkspace: need 3*M, prefer 2*M+M*NB) (RWorkspace: M*M) @@ -6233,7 +6233,7 @@ static real c_b2435 = .5f; claset_("F", n, n, &c_b56, &c_b57, &vt[vt_offset], ldvt); /* - Copy real matrix RWORK(IRVT) to singlecomplex matrix VT + Copy real matrix RWORK(IRVT) to complex matrix VT Overwrite VT by right singular vectors of A (CWorkspace: need 2*M+N, prefer 2*M+N*NB) (RWorkspace: M*M) @@ -6283,16 +6283,16 @@ static real c_b2435 = .5f; } /* cgesdd_ */ -/* Subroutine */ int cgesv_(integer *n, integer *nrhs, singlecomplex *a, integer * - lda, integer *ipiv, singlecomplex *b, integer *ldb, integer *info) +/* Subroutine */ int cgesv_(integer *n, integer *nrhs, complex *a, integer * + lda, integer *ipiv, complex *b, integer *ldb, integer *info) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1; /* Local variables */ - extern /* Subroutine */ int cgetrf_(integer *, integer *, singlecomplex *, - integer *, integer *, integer *), xerbla_(char *, integer *), cgetrs_(char *, integer *, integer *, singlecomplex *, integer - *, integer *, singlecomplex *, integer *, integer *); + extern /* Subroutine */ int cgetrf_(integer *, integer *, complex *, + integer *, integer *, integer *), xerbla_(char *, integer *), cgetrs_(char *, integer *, integer *, complex *, integer + *, integer *, complex *, integer *, integer *); /* @@ -6305,7 +6305,7 @@ static real c_b2435 = .5f; Purpose ======= - CGESV computes the solution to a singlecomplex system of linear equations + CGESV computes the solution to a complex system of linear equations A * X = B, where A is an N-by-N matrix and X and B are N-by-NRHS matrices. @@ -6401,22 +6401,22 @@ static real c_b2435 = .5f; } /* cgesv_ */ -/* Subroutine */ int cgetf2_(integer *m, integer *n, singlecomplex *a, integer *lda, +/* Subroutine */ int cgetf2_(integer *m, integer *n, complex *a, integer *lda, integer *ipiv, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, j, jp; - extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, - integer *), cgeru_(integer *, integer *, singlecomplex *, singlecomplex *, - integer *, singlecomplex *, integer *, singlecomplex *, integer *); + extern /* Subroutine */ int cscal_(integer *, complex *, complex *, + integer *), cgeru_(integer *, integer *, complex *, complex *, + integer *, complex *, integer *, complex *, integer *); static real sfmin; - extern /* Subroutine */ int cswap_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *); - extern integer icamax_(integer *, singlecomplex *, integer *); + extern /* Subroutine */ int cswap_(integer *, complex *, integer *, + complex *, integer *); + extern integer icamax_(integer *, complex *, integer *); extern doublereal slamch_(char *); extern /* Subroutine */ int xerbla_(char *, integer *); @@ -6568,27 +6568,27 @@ static real c_b2435 = .5f; } /* cgetf2_ */ -/* Subroutine */ int cgetrf_(integer *m, integer *n, singlecomplex *a, integer *lda, +/* Subroutine */ int cgetrf_(integer *m, integer *n, complex *a, integer *lda, integer *ipiv, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, j, jb, nb; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *); + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *); static integer iinfo; extern /* Subroutine */ int ctrsm_(char *, char *, char *, char *, - integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, + integer *, integer *, complex *, complex *, integer *, complex *, integer *), cgetf2_(integer *, - integer *, singlecomplex *, integer *, integer *, integer *), xerbla_( + integer *, complex *, integer *, integer *, integer *), xerbla_( char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); - extern /* Subroutine */ int claswp_(integer *, singlecomplex *, integer *, + extern /* Subroutine */ int claswp_(integer *, complex *, integer *, integer *, integer *, integer *, integer *); @@ -6759,8 +6759,8 @@ static real c_b2435 = .5f; } /* cgetrf_ */ -/* Subroutine */ int cgetrs_(char *trans, integer *n, integer *nrhs, singlecomplex * - a, integer *lda, integer *ipiv, singlecomplex *b, integer *ldb, integer * +/* Subroutine */ int cgetrs_(char *trans, integer *n, integer *nrhs, complex * + a, integer *lda, integer *ipiv, complex *b, integer *ldb, integer * info) { /* System generated locals */ @@ -6769,9 +6769,9 @@ static real c_b2435 = .5f; /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ int ctrsm_(char *, char *, char *, char *, - integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, + integer *, integer *, complex *, complex *, integer *, complex *, integer *), xerbla_(char *, - integer *), claswp_(integer *, singlecomplex *, integer *, + integer *), claswp_(integer *, complex *, integer *, integer *, integer *, integer *, integer *); static logical notran; @@ -6917,8 +6917,8 @@ static real c_b2435 = .5f; } /* cgetrs_ */ -/* Subroutine */ int cheevd_(char *jobz, char *uplo, integer *n, singlecomplex *a, - integer *lda, real *w, singlecomplex *work, integer *lwork, real *rwork, +/* Subroutine */ int cheevd_(char *jobz, char *uplo, integer *n, complex *a, + integer *lda, real *w, complex *work, integer *lwork, real *rwork, integer *lrwork, integer *iwork, integer *liwork, integer *info) { /* System generated locals */ @@ -6941,17 +6941,17 @@ static real c_b2435 = .5f; static integer llrwk, lropt; static logical wantz; static integer indwk2, llwrk2; - extern doublereal clanhe_(char *, char *, integer *, singlecomplex *, integer *, + extern doublereal clanhe_(char *, char *, integer *, complex *, integer *, real *); static integer iscale; extern /* Subroutine */ int clascl_(char *, integer *, integer *, real *, - real *, integer *, integer *, singlecomplex *, integer *, integer *), cstedc_(char *, integer *, real *, real *, singlecomplex *, - integer *, singlecomplex *, integer *, real *, integer *, integer *, + real *, integer *, integer *, complex *, integer *, integer *), cstedc_(char *, integer *, real *, real *, complex *, + integer *, complex *, integer *, real *, integer *, integer *, integer *, integer *); extern doublereal slamch_(char *); - extern /* Subroutine */ int chetrd_(char *, integer *, singlecomplex *, integer - *, real *, real *, singlecomplex *, singlecomplex *, integer *, integer *), clacpy_(char *, integer *, integer *, singlecomplex *, integer - *, singlecomplex *, integer *); + extern /* Subroutine */ int chetrd_(char *, integer *, complex *, integer + *, real *, real *, complex *, complex *, integer *, integer *), clacpy_(char *, integer *, integer *, complex *, integer + *, complex *, integer *); static real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -6961,8 +6961,8 @@ static real c_b2435 = .5f; extern /* Subroutine */ int ssterf_(integer *, real *, real *, integer *); static integer lrwmin; extern /* Subroutine */ int cunmtr_(char *, char *, char *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *, integer *); + integer *, complex *, integer *, complex *, complex *, integer *, + complex *, integer *, integer *); static integer llwork; static real smlnum; static logical lquery; @@ -6979,7 +6979,7 @@ static real c_b2435 = .5f; ======= CHEEVD computes all eigenvalues and, optionally, eigenvectors of a - singlecomplex Hermitian matrix A. If eigenvectors are desired, it uses a + complex Hermitian matrix A. If eigenvectors are desired, it uses a divide and conquer algorithm. The divide and conquer algorithm makes very mild assumptions about @@ -7260,30 +7260,30 @@ static real c_b2435 = .5f; } /* cheevd_ */ -/* Subroutine */ int chetd2_(char *uplo, integer *n, singlecomplex *a, integer *lda, - real *d__, real *e, singlecomplex *tau, integer *info) +/* Subroutine */ int chetd2_(char *uplo, integer *n, complex *a, integer *lda, + real *d__, real *e, complex *tau, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; real r__1; - singlecomplex q__1, q__2, q__3, q__4; + complex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__; - static singlecomplex taui; - extern /* Subroutine */ int cher2_(char *, integer *, singlecomplex *, singlecomplex * - , integer *, singlecomplex *, integer *, singlecomplex *, integer *); - static singlecomplex alpha; - extern /* Complex */ VOID cdotc_(singlecomplex *, integer *, singlecomplex *, integer - *, singlecomplex *, integer *); + static complex taui; + extern /* Subroutine */ int cher2_(char *, integer *, complex *, complex * + , integer *, complex *, integer *, complex *, integer *); + static complex alpha; + extern /* Complex */ VOID cdotc_(complex *, integer *, complex *, integer + *, complex *, integer *); extern logical lsame_(char *, char *); - extern /* Subroutine */ int chemv_(char *, integer *, singlecomplex *, singlecomplex * - , integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer * - ), caxpy_(integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *); + extern /* Subroutine */ int chemv_(char *, integer *, complex *, complex * + , integer *, complex *, integer *, complex *, complex *, integer * + ), caxpy_(integer *, complex *, complex *, integer *, + complex *, integer *); static logical upper; - extern /* Subroutine */ int clarfg_(integer *, singlecomplex *, singlecomplex *, - integer *, singlecomplex *), xerbla_(char *, integer *); + extern /* Subroutine */ int clarfg_(integer *, complex *, complex *, + integer *, complex *), xerbla_(char *, integer *); /* @@ -7296,7 +7296,7 @@ static real c_b2435 = .5f; Purpose ======= - CHETD2 reduces a singlecomplex Hermitian matrix A to real symmetric + CHETD2 reduces a complex Hermitian matrix A to real symmetric tridiagonal form T by a unitary similarity transformation: Q' * A * Q = T. @@ -7362,7 +7362,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in A(1:i-1,i+1), and tau in TAU(i). @@ -7375,7 +7375,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i), and tau in TAU(i). @@ -7596,24 +7596,24 @@ static real c_b2435 = .5f; } /* chetd2_ */ -/* Subroutine */ int chetrd_(char *uplo, integer *n, singlecomplex *a, integer *lda, - real *d__, real *e, singlecomplex *tau, singlecomplex *work, integer *lwork, +/* Subroutine */ int chetrd_(char *uplo, integer *n, complex *a, integer *lda, + real *d__, real *e, complex *tau, complex *work, integer *lwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, j, nb, kk, nx, iws; extern logical lsame_(char *, char *); static integer nbmin, iinfo; static logical upper; - extern /* Subroutine */ int chetd2_(char *, integer *, singlecomplex *, integer - *, real *, real *, singlecomplex *, integer *), cher2k_(char *, - char *, integer *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *, real *, singlecomplex *, integer *), clatrd_(char *, integer *, integer *, singlecomplex *, integer - *, real *, singlecomplex *, singlecomplex *, integer *), xerbla_(char + extern /* Subroutine */ int chetd2_(char *, integer *, complex *, integer + *, real *, real *, complex *, integer *), cher2k_(char *, + char *, integer *, integer *, complex *, complex *, integer *, + complex *, integer *, real *, complex *, integer *), clatrd_(char *, integer *, integer *, complex *, integer + *, real *, complex *, complex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -7631,7 +7631,7 @@ static real c_b2435 = .5f; Purpose ======= - CHETRD reduces a singlecomplex Hermitian matrix A to real symmetric + CHETRD reduces a complex Hermitian matrix A to real symmetric tridiagonal form T by a unitary similarity transformation: Q**H * A * Q = T. @@ -7708,7 +7708,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(i+1:n) = 0 and v(i) = 1; v(1:i-1) is stored on exit in A(1:i-1,i+1), and tau in TAU(i). @@ -7721,7 +7721,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(1:i) = 0 and v(i+1) = 1; v(i+2:n) is stored on exit in A(i+2:n,i), and tau in TAU(i). @@ -7952,33 +7952,33 @@ static real c_b2435 = .5f; } /* chetrd_ */ /* Subroutine */ int chseqr_(char *job, char *compz, integer *n, integer *ilo, - integer *ihi, singlecomplex *h__, integer *ldh, singlecomplex *w, singlecomplex *z__, - integer *ldz, singlecomplex *work, integer *lwork, integer *info) + integer *ihi, complex *h__, integer *ldh, complex *w, complex *z__, + integer *ldz, complex *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3[2]; real r__1, r__2, r__3; - singlecomplex q__1; + complex q__1; char ch__1[2]; /* Local variables */ - static singlecomplex hl[2401] /* was [49][49] */; + static complex hl[2401] /* was [49][49] */; static integer kbot, nmin; extern logical lsame_(char *, char *); - extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *); + extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, + complex *, integer *); static logical initz; - static singlecomplex workl[49]; + static complex workl[49]; static logical wantt, wantz; extern /* Subroutine */ int claqr0_(logical *, logical *, integer *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, integer *, integer *), + integer *, integer *, complex *, integer *, complex *, integer *, + integer *, complex *, integer *, complex *, integer *, integer *), clahqr_(logical *, logical *, integer *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, integer *, integer *, singlecomplex *, + complex *, integer *, complex *, integer *, integer *, complex *, integer *, integer *), clacpy_(char *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, integer *), claset_(char - *, integer *, integer *, singlecomplex *, singlecomplex *, singlecomplex *, integer + complex *, integer *, complex *, integer *), claset_(char + *, integer *, integer *, complex *, complex *, complex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -8404,23 +8404,23 @@ static real c_b2435 = .5f; return 0; } /* chseqr_ */ -/* Subroutine */ int clabrd_(integer *m, integer *n, integer *nb, singlecomplex *a, - integer *lda, real *d__, real *e, singlecomplex *tauq, singlecomplex *taup, - singlecomplex *x, integer *ldx, singlecomplex *y, integer *ldy) +/* Subroutine */ int clabrd_(integer *m, integer *n, integer *nb, complex *a, + integer *lda, real *d__, real *e, complex *tauq, complex *taup, + complex *x, integer *ldx, complex *y, integer *ldy) { /* System generated locals */ integer a_dim1, a_offset, x_dim1, x_offset, y_dim1, y_offset, i__1, i__2, i__3; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__; - static singlecomplex alpha; - extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, - integer *), cgemv_(char *, integer *, integer *, singlecomplex *, - singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, - integer *), clarfg_(integer *, singlecomplex *, singlecomplex *, - integer *, singlecomplex *), clacgv_(integer *, singlecomplex *, integer *); + static complex alpha; + extern /* Subroutine */ int cscal_(integer *, complex *, complex *, + integer *), cgemv_(char *, integer *, integer *, complex *, + complex *, integer *, complex *, integer *, complex *, complex *, + integer *), clarfg_(integer *, complex *, complex *, + integer *, complex *), clacgv_(integer *, complex *, integer *); /* @@ -8433,7 +8433,7 @@ static real c_b2435 = .5f; Purpose ======= - CLABRD reduces the first NB rows and columns of a singlecomplex general + CLABRD reduces the first NB rows and columns of a complex general m by n matrix A to upper or lower real bidiagonal form by a unitary transformation Q' * A * P, and returns the matrices X and Y which are needed to apply the transformation to the unreduced part of A. @@ -8518,7 +8518,7 @@ static real c_b2435 = .5f; H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' - where tauq and taup are singlecomplex scalars, and v and u are singlecomplex + where tauq and taup are complex scalars, and v and u are complex vectors. If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in @@ -8875,11 +8875,11 @@ static real c_b2435 = .5f; } /* clabrd_ */ -/* Subroutine */ int clacgv_(integer *n, singlecomplex *x, integer *incx) +/* Subroutine */ int clacgv_(integer *n, complex *x, integer *incx) { /* System generated locals */ integer i__1, i__2; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, ioff; @@ -8895,7 +8895,7 @@ static real c_b2435 = .5f; Purpose ======= - CLACGV conjugates a singlecomplex vector of length N. + CLACGV conjugates a complex vector of length N. Arguments ========= @@ -8948,7 +8948,7 @@ static real c_b2435 = .5f; } /* clacgv_ */ /* Subroutine */ int clacp2_(char *uplo, integer *m, integer *n, real *a, - integer *lda, singlecomplex *b, integer *ldb) + integer *lda, complex *b, integer *ldb) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4; @@ -8969,7 +8969,7 @@ static real c_b2435 = .5f; ======= CLACP2 copies all or part of a real two-dimensional matrix A to a - singlecomplex matrix B. + complex matrix B. Arguments ========= @@ -9059,8 +9059,8 @@ static real c_b2435 = .5f; } /* clacp2_ */ -/* Subroutine */ int clacpy_(char *uplo, integer *m, integer *n, singlecomplex *a, - integer *lda, singlecomplex *b, integer *ldb) +/* Subroutine */ int clacpy_(char *uplo, integer *m, integer *n, complex *a, + integer *lda, complex *b, integer *ldb) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4; @@ -9171,14 +9171,14 @@ static real c_b2435 = .5f; } /* clacpy_ */ -/* Subroutine */ int clacrm_(integer *m, integer *n, singlecomplex *a, integer *lda, - real *b, integer *ldb, singlecomplex *c__, integer *ldc, real *rwork) +/* Subroutine */ int clacrm_(integer *m, integer *n, complex *a, integer *lda, + real *b, integer *ldb, complex *c__, integer *ldc, real *rwork) { /* System generated locals */ integer b_dim1, b_offset, a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5; real r__1; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, j, l; @@ -9199,8 +9199,8 @@ static real c_b2435 = .5f; CLACRM performs a very simple matrix-matrix multiplication: C := A * B, - where A is M by N and singlecomplex; B is N by N and real; - C is M by N and singlecomplex. + where A is M by N and complex; B is N by N and real; + C is M by N and complex. Arguments ========= @@ -9315,11 +9315,11 @@ static real c_b2435 = .5f; } /* clacrm_ */ -/* Complex */ VOID cladiv_(singlecomplex * ret_val, singlecomplex *x, singlecomplex *y) +/* Complex */ VOID cladiv_(complex * ret_val, complex *x, complex *y) { /* System generated locals */ real r__1, r__2, r__3, r__4; - singlecomplex q__1; + complex q__1; /* Local variables */ static real zi, zr; @@ -9337,7 +9337,7 @@ static real c_b2435 = .5f; Purpose ======= - CLADIV := X / Y, where X and Y are singlecomplex. The computation of X / Y + CLADIV := X / Y, where X and Y are complex. The computation of X / Y will not overflow on an intermediary step unless the results overflows. @@ -9346,7 +9346,7 @@ static real c_b2435 = .5f; X (input) COMPLEX Y (input) COMPLEX - The singlecomplex scalars X and Y. + The complex scalars X and Y. ===================================================================== */ @@ -9367,7 +9367,7 @@ static real c_b2435 = .5f; } /* cladiv_ */ /* Subroutine */ int claed0_(integer *qsiz, integer *n, real *d__, real *e, - singlecomplex *q, integer *ldq, singlecomplex *qstore, integer *ldqs, real *rwork, + complex *q, integer *ldq, complex *qstore, integer *ldqs, real *rwork, integer *iwork, integer *info) { /* System generated locals */ @@ -9378,20 +9378,20 @@ static real c_b2435 = .5f; static integer i__, j, k, ll, iq, lgn, msd2, smm1, spm1, spm2; static real temp; static integer curr, iperm; - extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *); + extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, + complex *, integer *); static integer indxq, iwrem; extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *, integer *); static integer iqptr; extern /* Subroutine */ int claed7_(integer *, integer *, integer *, - integer *, integer *, integer *, real *, singlecomplex *, integer *, + integer *, integer *, integer *, real *, complex *, integer *, real *, integer *, real *, integer *, integer *, integer *, - integer *, integer *, real *, singlecomplex *, real *, integer *, + integer *, integer *, real *, complex *, real *, integer *, integer *); static integer tlvls; - extern /* Subroutine */ int clacrm_(integer *, integer *, singlecomplex *, - integer *, real *, integer *, singlecomplex *, integer *, real *); + extern /* Subroutine */ int clacrm_(integer *, integer *, complex *, + integer *, real *, integer *, complex *, integer *, real *); static integer igivcl; extern /* Subroutine */ int xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, @@ -9714,10 +9714,10 @@ static real c_b2435 = .5f; } /* claed0_ */ /* Subroutine */ int claed7_(integer *n, integer *cutpnt, integer *qsiz, - integer *tlvls, integer *curlvl, integer *curpbm, real *d__, singlecomplex * + integer *tlvls, integer *curlvl, integer *curpbm, real *d__, complex * q, integer *ldq, real *rho, integer *indxq, real *qstore, integer * qptr, integer *prmptr, integer *perm, integer *givptr, integer * - givcol, real *givnum, singlecomplex *work, real *rwork, integer *iwork, + givcol, real *givnum, complex *work, real *rwork, integer *iwork, integer *info) { /* System generated locals */ @@ -9726,8 +9726,8 @@ static real c_b2435 = .5f; /* Local variables */ static integer i__, k, n1, n2, iq, iw, iz, ptr, indx, curr, indxc, indxp; extern /* Subroutine */ int claed8_(integer *, integer *, integer *, - singlecomplex *, integer *, real *, real *, integer *, real *, real *, - singlecomplex *, integer *, real *, integer *, integer *, integer *, + complex *, integer *, real *, real *, integer *, real *, real *, + complex *, integer *, real *, integer *, integer *, integer *, integer *, integer *, integer *, real *, integer *), slaed9_( integer *, integer *, integer *, integer *, real *, real *, integer *, real *, real *, real *, real *, integer *, integer *), @@ -9735,8 +9735,8 @@ static real c_b2435 = .5f; integer *, integer *, integer *, real *, real *, integer *, real * , real *, integer *); static integer idlmda; - extern /* Subroutine */ int clacrm_(integer *, integer *, singlecomplex *, - integer *, real *, integer *, singlecomplex *, integer *, real *), + extern /* Subroutine */ int clacrm_(integer *, integer *, complex *, + integer *, real *, integer *, complex *, integer *, real *), xerbla_(char *, integer *), slamrg_(integer *, integer *, real *, integer *, integer *, integer *); static integer coltyp; @@ -10015,9 +10015,9 @@ static real c_b2435 = .5f; } /* claed7_ */ -/* Subroutine */ int claed8_(integer *k, integer *n, integer *qsiz, singlecomplex * +/* Subroutine */ int claed8_(integer *k, integer *n, integer *qsiz, complex * q, integer *ldq, real *d__, real *rho, integer *cutpnt, real *z__, - real *dlamda, singlecomplex *q2, integer *ldq2, real *w, integer *indxp, + real *dlamda, complex *q2, integer *ldq2, real *w, integer *indxp, integer *indx, integer *indxq, integer *perm, integer *givptr, integer *givcol, real *givnum, integer *info) { @@ -10033,13 +10033,13 @@ static real c_b2435 = .5f; static real eps, tau, tol; static integer jlam, imax, jmax; extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *), - ccopy_(integer *, singlecomplex *, integer *, singlecomplex *, integer *), - csrot_(integer *, singlecomplex *, integer *, singlecomplex *, integer *, + ccopy_(integer *, complex *, integer *, complex *, integer *), + csrot_(integer *, complex *, integer *, complex *, integer *, real *, real *), scopy_(integer *, real *, integer *, real *, integer *); extern doublereal slapy2_(real *, real *), slamch_(char *); - extern /* Subroutine */ int clacpy_(char *, integer *, integer *, singlecomplex - *, integer *, singlecomplex *, integer *), xerbla_(char *, + extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex + *, integer *, complex *, integer *), xerbla_(char *, integer *); extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ int slamrg_(integer *, integer *, real *, integer @@ -10436,43 +10436,43 @@ static real c_b2435 = .5f; } /* claed8_ */ /* Subroutine */ int clahqr_(logical *wantt, logical *wantz, integer *n, - integer *ilo, integer *ihi, singlecomplex *h__, integer *ldh, singlecomplex *w, - integer *iloz, integer *ihiz, singlecomplex *z__, integer *ldz, integer * + integer *ilo, integer *ihi, complex *h__, integer *ldh, complex *w, + integer *iloz, integer *ihiz, complex *z__, integer *ldz, integer * info) { /* System generated locals */ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4; real r__1, r__2, r__3, r__4, r__5, r__6; - singlecomplex q__1, q__2, q__3, q__4, q__5, q__6, q__7; + complex q__1, q__2, q__3, q__4, q__5, q__6, q__7; /* Local variables */ static integer i__, j, k, l, m; static real s; - static singlecomplex t, u, v[2], x, y; + static complex t, u, v[2], x, y; static integer i1, i2; - static singlecomplex t1; + static complex t1; static real t2; - static singlecomplex v2; + static complex v2; static real aa, ab, ba, bb, h10; - static singlecomplex h11; + static complex h11; static real h21; - static singlecomplex h22, sc; + static complex h22, sc; static integer nh, nz; static real sx; static integer jhi; - static singlecomplex h11s; + static complex h11s; static integer jlo, its; static real ulp; - static singlecomplex sum; + static complex sum; static real tst; - static singlecomplex temp; - extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, - integer *), ccopy_(integer *, singlecomplex *, integer *, singlecomplex *, + static complex temp; + extern /* Subroutine */ int cscal_(integer *, complex *, complex *, + integer *), ccopy_(integer *, complex *, integer *, complex *, integer *); static real rtemp; extern /* Subroutine */ int slabad_(real *, real *), clarfg_(integer *, - singlecomplex *, singlecomplex *, integer *, singlecomplex *); - extern /* Complex */ VOID cladiv_(singlecomplex *, singlecomplex *, singlecomplex *); + complex *, complex *, integer *, complex *); + extern /* Complex */ VOID cladiv_(complex *, complex *, complex *); extern doublereal slamch_(char *); static real safmin, safmax, smlnum; @@ -11166,33 +11166,33 @@ static real c_b2435 = .5f; } /* clahqr_ */ -/* Subroutine */ int clahr2_(integer *n, integer *k, integer *nb, singlecomplex *a, - integer *lda, singlecomplex *tau, singlecomplex *t, integer *ldt, singlecomplex *y, +/* Subroutine */ int clahr2_(integer *n, integer *k, integer *nb, complex *a, + integer *lda, complex *tau, complex *t, integer *ldt, complex *y, integer *ldy) { /* System generated locals */ integer a_dim1, a_offset, t_dim1, t_offset, y_dim1, y_offset, i__1, i__2, i__3; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__; - static singlecomplex ei; - extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, + static complex ei; + extern /* Subroutine */ int cscal_(integer *, complex *, complex *, integer *), cgemm_(char *, char *, integer *, integer *, integer * - , singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex * - , singlecomplex *, integer *), cgemv_(char *, integer *, - integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *), ccopy_(integer *, - singlecomplex *, integer *, singlecomplex *, integer *), ctrmm_(char *, char * - , char *, char *, integer *, integer *, singlecomplex *, singlecomplex *, - integer *, singlecomplex *, integer *), - caxpy_(integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, - integer *), ctrmv_(char *, char *, char *, integer *, singlecomplex *, - integer *, singlecomplex *, integer *), clarfg_( - integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), clacgv_( - integer *, singlecomplex *, integer *), clacpy_(char *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, integer *); + , complex *, complex *, integer *, complex *, integer *, complex * + , complex *, integer *), cgemv_(char *, integer *, + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *), ccopy_(integer *, + complex *, integer *, complex *, integer *), ctrmm_(char *, char * + , char *, char *, integer *, integer *, complex *, complex *, + integer *, complex *, integer *), + caxpy_(integer *, complex *, complex *, integer *, complex *, + integer *), ctrmv_(char *, char *, char *, integer *, complex *, + integer *, complex *, integer *), clarfg_( + integer *, complex *, complex *, integer *, complex *), clacgv_( + integer *, complex *, integer *), clacpy_(char *, integer *, + integer *, complex *, integer *, complex *, integer *); /* -- LAPACK auxiliary routine (version 3.2.1) -- */ @@ -11205,7 +11205,7 @@ static real c_b2435 = .5f; Purpose ======= - CLAHR2 reduces the first NB columns of A singlecomplex general n-BY-(n-k+1) + CLAHR2 reduces the first NB columns of A complex general n-BY-(n-k+1) matrix A so that elements below the k-th subdiagonal are zero. The reduction is performed by an unitary similarity transformation Q' * A * Q. The routine returns the matrices V and T which determine @@ -11266,7 +11266,7 @@ static real c_b2435 = .5f; H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in A(i+k+1:n,i), and tau in TAU(i). @@ -11479,7 +11479,7 @@ static real c_b2435 = .5f; } /* clahr2_ */ /* Subroutine */ int clals0_(integer *icompq, integer *nl, integer *nr, - integer *sqre, integer *nrhs, singlecomplex *b, integer *ldb, singlecomplex *bx, + integer *sqre, integer *nrhs, complex *b, integer *ldb, complex *bx, integer *ldbx, integer *perm, integer *givptr, integer *givcol, integer *ldgcol, real *givnum, integer *ldgnum, real *poles, real * difl, real *difr, real *z__, integer *k, real *c__, real *s, real * @@ -11490,7 +11490,7 @@ static real c_b2435 = .5f; givnum_offset, poles_dim1, poles_offset, b_dim1, b_offset, bx_dim1, bx_offset, i__1, i__2, i__3, i__4, i__5; real r__1; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, j, m, n; @@ -11500,15 +11500,15 @@ static real c_b2435 = .5f; static integer jrow; extern doublereal snrm2_(integer *, real *, integer *); static real diflj, difrj, dsigj; - extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *), sgemv_(char *, integer *, integer *, real * - , real *, integer *, real *, integer *, real *, real *, integer *), csrot_(integer *, singlecomplex *, integer *, singlecomplex *, + extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, + complex *, integer *), sgemv_(char *, integer *, integer *, real * + , real *, integer *, real *, integer *, real *, real *, integer *), csrot_(integer *, complex *, integer *, complex *, integer *, real *, real *); extern doublereal slamc3_(real *, real *); extern /* Subroutine */ int clascl_(char *, integer *, integer *, real *, - real *, integer *, integer *, singlecomplex *, integer *, integer *), csscal_(integer *, real *, singlecomplex *, integer *), - clacpy_(char *, integer *, integer *, singlecomplex *, integer *, - singlecomplex *, integer *), xerbla_(char *, integer *); + real *, integer *, integer *, complex *, integer *, integer *), csscal_(integer *, real *, complex *, integer *), + clacpy_(char *, integer *, integer *, complex *, integer *, + complex *, integer *), xerbla_(char *, integer *); static real dsigjp; @@ -11813,7 +11813,7 @@ static real c_b2435 = .5f; temp = snrm2_(k, &rwork[1], &c__1); /* - Since B and BX are singlecomplex, the following call to SGEMV + Since B and BX are complex, the following call to SGEMV is performed in two steps (real and imaginary parts). CALL SGEMV( 'T', K, NRHS, ONE, BX, LDBX, WORK, 1, ZERO, @@ -11917,7 +11917,7 @@ static real c_b2435 = .5f; } /* - Since B and BX are singlecomplex, the following call to SGEMV + Since B and BX are complex, the following call to SGEMV is performed in two steps (real and imaginary parts). CALL SGEMV( 'T', K, NRHS, ONE, B, LDB, WORK, 1, ZERO, @@ -12012,7 +12012,7 @@ static real c_b2435 = .5f; } /* clals0_ */ /* Subroutine */ int clalsa_(integer *icompq, integer *smlsiz, integer *n, - integer *nrhs, singlecomplex *b, integer *ldb, singlecomplex *bx, integer *ldbx, + integer *nrhs, complex *b, integer *ldb, complex *bx, integer *ldbx, real *u, integer *ldu, real *vt, integer *k, real *difl, real *difr, real *z__, real *poles, integer *givptr, integer *givcol, integer * ldgcol, integer *perm, real *givnum, real *c__, real *s, real *rwork, @@ -12024,7 +12024,7 @@ static real c_b2435 = .5f; poles_dim1, poles_offset, u_dim1, u_offset, vt_dim1, vt_offset, z_dim1, z_offset, b_dim1, b_offset, bx_dim1, bx_offset, i__1, i__2, i__3, i__4, i__5, i__6; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, j, i1, ic, lf, nd, ll, nl, nr, im1, nlf, nrf, lvl, @@ -12034,9 +12034,9 @@ static real c_b2435 = .5f; integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); static integer ndimr; - extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *), clals0_(integer *, integer *, integer *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, + extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, + complex *, integer *), clals0_(integer *, integer *, integer *, + integer *, integer *, complex *, integer *, complex *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, real *, real *, real *, integer *, real *, real *, real *, integer *), xerbla_(char *, integer *), slasdt_(integer * @@ -12302,7 +12302,7 @@ static real c_b2435 = .5f; nrf = ic + 1; /* - Since B and BX are singlecomplex, the following call to SGEMM + Since B and BX are complex, the following call to SGEMM is performed in two steps (real and imaginary parts). CALL SGEMM( 'T', 'N', NL, NRHS, NL, ONE, U( NLF, 1 ), LDU, @@ -12356,7 +12356,7 @@ static real c_b2435 = .5f; } /* - Since B and BX are singlecomplex, the following call to SGEMM + Since B and BX are complex, the following call to SGEMM is performed in two steps (real and imaginary parts). CALL SGEMM( 'T', 'N', NR, NRHS, NR, ONE, U( NRF, 1 ), LDU, @@ -12546,7 +12546,7 @@ static real c_b2435 = .5f; nrf = ic + 1; /* - Since B and BX are singlecomplex, the following call to SGEMM is + Since B and BX are complex, the following call to SGEMM is performed in two steps (real and imaginary parts). CALL SGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU, @@ -12601,7 +12601,7 @@ static real c_b2435 = .5f; } /* - Since B and BX are singlecomplex, the following call to SGEMM is + Since B and BX are complex, the following call to SGEMM is performed in two steps (real and imaginary parts). CALL SGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU, @@ -12667,14 +12667,14 @@ static real c_b2435 = .5f; } /* clalsa_ */ /* Subroutine */ int clalsd_(char *uplo, integer *smlsiz, integer *n, integer - *nrhs, real *d__, real *e, singlecomplex *b, integer *ldb, real *rcond, - integer *rank, singlecomplex *work, real *rwork, integer *iwork, integer * + *nrhs, real *d__, real *e, complex *b, integer *ldb, real *rcond, + integer *rank, complex *work, real *rwork, integer *iwork, integer * info) { /* System generated locals */ integer b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5, i__6; real r__1; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer c__, i__, j, k; @@ -12695,27 +12695,27 @@ static real c_b2435 = .5f; integer *, real *, real *, integer *, real *, integer *, real *, real *, integer *); static integer irwib; - extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *); + extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, + complex *, integer *); static integer poles, sizei, irwrb, nsize; - extern /* Subroutine */ int csrot_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *, real *, real *); + extern /* Subroutine */ int csrot_(integer *, complex *, integer *, + complex *, integer *, real *, real *); static integer irwvt, icmpq1, icmpq2; extern /* Subroutine */ int clalsa_(integer *, integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, integer *, real *, + integer *, complex *, integer *, complex *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real * , real *, integer *, integer *), clascl_(char *, integer *, - integer *, real *, real *, integer *, integer *, singlecomplex *, + integer *, real *, real *, integer *, integer *, complex *, integer *, integer *); extern doublereal slamch_(char *); extern /* Subroutine */ int slasda_(integer *, integer *, integer *, integer *, real *, real *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *, real *, real *, real *, real *, integer *, integer *), - clacpy_(char *, integer *, integer *, singlecomplex *, integer *, - singlecomplex *, integer *), claset_(char *, integer *, integer - *, singlecomplex *, singlecomplex *, singlecomplex *, integer *), xerbla_( + clacpy_(char *, integer *, integer *, complex *, integer *, + complex *, integer *), claset_(char *, integer *, integer + *, complex *, complex *, complex *, integer *), xerbla_( char *, integer *), slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer * ); @@ -12963,7 +12963,7 @@ static real c_b2435 = .5f; /* In the real version, B is passed to SLASDQ and multiplied - internally by Q'. Here B is singlecomplex and that product is + internally by Q'. Here B is complex and that product is computed below in two steps (real and imaginary parts). */ @@ -13027,7 +13027,7 @@ static real c_b2435 = .5f; } /* - Since B is singlecomplex, the following call to SGEMM is performed + Since B is complex, the following call to SGEMM is performed in two steps (real and imaginary parts). That is for V * B (in the real version of the code V' is stored in WORK). @@ -13199,7 +13199,7 @@ static real c_b2435 = .5f; /* In the real version, B is passed to SLASDQ and multiplied - internally by Q'. Here B is singlecomplex and that product is + internally by Q'. Here B is complex and that product is computed below in two steps (real and imaginary parts). */ @@ -13320,7 +13320,7 @@ static real c_b2435 = .5f; } else if (nsize <= *smlsiz) { /* - Since B and BX are singlecomplex, the following call to SGEMM + Since B and BX are complex, the following call to SGEMM is performed in two steps (real and imaginary parts). CALL SGEMM( 'T', 'N', NSIZE, NRHS, NSIZE, ONE, @@ -13404,7 +13404,7 @@ static real c_b2435 = .5f; } /* clalsd_ */ -doublereal clange_(char *norm, integer *m, integer *n, singlecomplex *a, integer * +doublereal clange_(char *norm, integer *m, integer *n, complex *a, integer * lda, real *work) { /* System generated locals */ @@ -13416,7 +13416,7 @@ doublereal clange_(char *norm, integer *m, integer *n, singlecomplex *a, integer static real sum, scale; extern logical lsame_(char *, char *); static real value; - extern /* Subroutine */ int classq_(integer *, singlecomplex *, integer *, real + extern /* Subroutine */ int classq_(integer *, complex *, integer *, real *, real *); @@ -13432,7 +13432,7 @@ doublereal clange_(char *norm, integer *m, integer *n, singlecomplex *a, integer CLANGE returns the value of the one norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a - singlecomplex matrix A. + complex matrix A. Description =========== @@ -13570,7 +13570,7 @@ doublereal clange_(char *norm, integer *m, integer *n, singlecomplex *a, integer } /* clange_ */ -doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer * +doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer * lda, real *work) { /* System generated locals */ @@ -13582,7 +13582,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer static real sum, absa, scale; extern logical lsame_(char *, char *); static real value; - extern /* Subroutine */ int classq_(integer *, singlecomplex *, integer *, real + extern /* Subroutine */ int classq_(integer *, complex *, integer *, real *, real *); @@ -13598,7 +13598,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer CLANHE returns the value of the one norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a - singlecomplex hermitian matrix A. + complex hermitian matrix A. Description =========== @@ -13803,48 +13803,48 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clanhe_ */ /* Subroutine */ int claqr0_(logical *wantt, logical *wantz, integer *n, - integer *ilo, integer *ihi, singlecomplex *h__, integer *ldh, singlecomplex *w, - integer *iloz, integer *ihiz, singlecomplex *z__, integer *ldz, singlecomplex * + integer *ilo, integer *ihi, complex *h__, integer *ldh, complex *w, + integer *iloz, integer *ihiz, complex *z__, integer *ldz, complex * work, integer *lwork, integer *info) { /* System generated locals */ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5; real r__1, r__2, r__3, r__4, r__5, r__6, r__7, r__8; - singlecomplex q__1, q__2, q__3, q__4, q__5; + complex q__1, q__2, q__3, q__4, q__5; /* Local variables */ static integer i__, k; static real s; - static singlecomplex aa, bb, cc, dd; + static complex aa, bb, cc, dd; static integer ld, nh, it, ks, kt, ku, kv, ls, ns, nw; - static singlecomplex tr2, det; + static complex tr2, det; static integer inf, kdu, nho, nve, kwh, nsr, nwr, kwv, ndec, ndfl, kbot, nmin; - static singlecomplex swap; + static complex swap; static integer ktop; - static singlecomplex zdum[1] /* was [1][1] */; + static complex zdum[1] /* was [1][1] */; static integer kacc22, itmax, nsmax, nwmax, kwtop; extern /* Subroutine */ int claqr3_(logical *, logical *, integer *, - integer *, integer *, integer *, singlecomplex *, integer *, integer *, - integer *, singlecomplex *, integer *, integer *, integer *, singlecomplex *, - singlecomplex *, integer *, integer *, singlecomplex *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, integer *), claqr4_(logical *, - logical *, integer *, integer *, integer *, singlecomplex *, integer *, - singlecomplex *, integer *, integer *, singlecomplex *, integer *, singlecomplex *, + integer *, integer *, integer *, complex *, integer *, integer *, + integer *, complex *, integer *, integer *, integer *, complex *, + complex *, integer *, integer *, complex *, integer *, integer *, + complex *, integer *, complex *, integer *), claqr4_(logical *, + logical *, integer *, integer *, integer *, complex *, integer *, + complex *, integer *, integer *, complex *, integer *, complex *, integer *, integer *), claqr5_(logical *, logical *, integer *, - integer *, integer *, integer *, integer *, singlecomplex *, singlecomplex *, - integer *, integer *, integer *, singlecomplex *, integer *, singlecomplex *, - integer *, singlecomplex *, integer *, integer *, singlecomplex *, integer *, - integer *, singlecomplex *, integer *); + integer *, integer *, integer *, integer *, complex *, complex *, + integer *, integer *, integer *, complex *, integer *, complex *, + integer *, complex *, integer *, integer *, complex *, integer *, + integer *, complex *, integer *); static integer nibble; extern /* Subroutine */ int clahqr_(logical *, logical *, integer *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, - integer *, singlecomplex *, integer *, integer *), clacpy_(char *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *); + integer *, integer *, complex *, integer *, complex *, integer *, + integer *, complex *, integer *, integer *), clacpy_(char *, + integer *, integer *, complex *, integer *, complex *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static char jbcmpz[2]; - static singlecomplex rtdisc; + static complex rtdisc; static integer nwupbd; static logical sorted; static integer lwkopt; @@ -14585,17 +14585,17 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer return 0; } /* claqr0_ */ -/* Subroutine */ int claqr1_(integer *n, singlecomplex *h__, integer *ldh, singlecomplex * - s1, singlecomplex *s2, singlecomplex *v) +/* Subroutine */ int claqr1_(integer *n, complex *h__, integer *ldh, complex * + s1, complex *s2, complex *v) { /* System generated locals */ integer h_dim1, h_offset, i__1, i__2, i__3, i__4; real r__1, r__2, r__3, r__4, r__5, r__6; - singlecomplex q__1, q__2, q__3, q__4, q__5, q__6, q__7, q__8; + complex q__1, q__2, q__3, q__4, q__5, q__6, q__7, q__8; /* Local variables */ static real s; - static singlecomplex h21s, h31s; + static complex h21s, h31s; /* @@ -14753,52 +14753,52 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* claqr1_ */ /* Subroutine */ int claqr2_(logical *wantt, logical *wantz, integer *n, - integer *ktop, integer *kbot, integer *nw, singlecomplex *h__, integer *ldh, - integer *iloz, integer *ihiz, singlecomplex *z__, integer *ldz, integer * - ns, integer *nd, singlecomplex *sh, singlecomplex *v, integer *ldv, integer *nh, - singlecomplex *t, integer *ldt, integer *nv, singlecomplex *wv, integer *ldwv, - singlecomplex *work, integer *lwork) + integer *ktop, integer *kbot, integer *nw, complex *h__, integer *ldh, + integer *iloz, integer *ihiz, complex *z__, integer *ldz, integer * + ns, integer *nd, complex *sh, complex *v, integer *ldv, integer *nh, + complex *t, integer *ldt, integer *nv, complex *wv, integer *ldwv, + complex *work, integer *lwork) { /* System generated locals */ integer h_dim1, h_offset, t_dim1, t_offset, v_dim1, v_offset, wv_dim1, wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4; real r__1, r__2, r__3, r__4, r__5, r__6; - singlecomplex q__1, q__2; + complex q__1, q__2; /* Local variables */ static integer i__, j; - static singlecomplex s; + static complex s; static integer jw; static real foo; static integer kln; - static singlecomplex tau; + static complex tau; static integer knt; static real ulp; static integer lwk1, lwk2; - static singlecomplex beta; + static complex beta; static integer kcol, info, ifst, ilst, ltop, krow; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * - , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), - cgemm_(char *, char *, integer *, integer *, integer *, singlecomplex *, - singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, - integer *), ccopy_(integer *, singlecomplex *, integer - *, singlecomplex *, integer *); + extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * + , integer *, complex *, complex *, integer *, complex *), + cgemm_(char *, char *, integer *, integer *, integer *, complex *, + complex *, integer *, complex *, integer *, complex *, complex *, + integer *), ccopy_(integer *, complex *, integer + *, complex *, integer *); static integer infqr, kwtop; extern /* Subroutine */ int slabad_(real *, real *), cgehrd_(integer *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, - integer *, integer *), clarfg_(integer *, singlecomplex *, singlecomplex *, - integer *, singlecomplex *); + integer *, integer *, complex *, integer *, complex *, complex *, + integer *, integer *), clarfg_(integer *, complex *, complex *, + integer *, complex *); extern doublereal slamch_(char *); extern /* Subroutine */ int clahqr_(logical *, logical *, integer *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, - integer *, singlecomplex *, integer *, integer *), clacpy_(char *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *), claset_(char *, integer *, integer *, singlecomplex *, singlecomplex - *, singlecomplex *, integer *); + integer *, integer *, complex *, integer *, complex *, integer *, + integer *, complex *, integer *, integer *), clacpy_(char *, + integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex + *, complex *, integer *); static real safmin, safmax; - extern /* Subroutine */ int ctrexc_(char *, integer *, singlecomplex *, integer - *, singlecomplex *, integer *, integer *, integer *, integer *), + extern /* Subroutine */ int ctrexc_(char *, integer *, complex *, integer + *, complex *, integer *, integer *, integer *, integer *), cunmhr_(char *, char *, integer *, integer *, integer *, integer - *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex + *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); static real smlnum; static integer lwkopt; @@ -15327,57 +15327,57 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* claqr2_ */ /* Subroutine */ int claqr3_(logical *wantt, logical *wantz, integer *n, - integer *ktop, integer *kbot, integer *nw, singlecomplex *h__, integer *ldh, - integer *iloz, integer *ihiz, singlecomplex *z__, integer *ldz, integer * - ns, integer *nd, singlecomplex *sh, singlecomplex *v, integer *ldv, integer *nh, - singlecomplex *t, integer *ldt, integer *nv, singlecomplex *wv, integer *ldwv, - singlecomplex *work, integer *lwork) + integer *ktop, integer *kbot, integer *nw, complex *h__, integer *ldh, + integer *iloz, integer *ihiz, complex *z__, integer *ldz, integer * + ns, integer *nd, complex *sh, complex *v, integer *ldv, integer *nh, + complex *t, integer *ldt, integer *nv, complex *wv, integer *ldwv, + complex *work, integer *lwork) { /* System generated locals */ integer h_dim1, h_offset, t_dim1, t_offset, v_dim1, v_offset, wv_dim1, wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4; real r__1, r__2, r__3, r__4, r__5, r__6; - singlecomplex q__1, q__2; + complex q__1, q__2; /* Local variables */ static integer i__, j; - static singlecomplex s; + static complex s; static integer jw; static real foo; static integer kln; - static singlecomplex tau; + static complex tau; static integer knt; static real ulp; static integer lwk1, lwk2, lwk3; - static singlecomplex beta; + static complex beta; static integer kcol, info, nmin, ifst, ilst, ltop, krow; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * - , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), - cgemm_(char *, char *, integer *, integer *, integer *, singlecomplex *, - singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, - integer *), ccopy_(integer *, singlecomplex *, integer - *, singlecomplex *, integer *); + extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * + , integer *, complex *, complex *, integer *, complex *), + cgemm_(char *, char *, integer *, integer *, integer *, complex *, + complex *, integer *, complex *, integer *, complex *, complex *, + integer *), ccopy_(integer *, complex *, integer + *, complex *, integer *); static integer infqr, kwtop; extern /* Subroutine */ int claqr4_(logical *, logical *, integer *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, integer *, integer *), + integer *, integer *, complex *, integer *, complex *, integer *, + integer *, complex *, integer *, complex *, integer *, integer *), slabad_(real *, real *), cgehrd_(integer *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer *) - , clarfg_(integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *); + complex *, integer *, complex *, complex *, integer *, integer *) + , clarfg_(integer *, complex *, complex *, integer *, complex *); extern doublereal slamch_(char *); extern /* Subroutine */ int clahqr_(logical *, logical *, integer *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, - integer *, singlecomplex *, integer *, integer *), clacpy_(char *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *), claset_(char *, integer *, integer *, singlecomplex *, singlecomplex - *, singlecomplex *, integer *); + integer *, integer *, complex *, integer *, complex *, integer *, + integer *, complex *, integer *, integer *), clacpy_(char *, + integer *, integer *, complex *, integer *, complex *, integer *), claset_(char *, integer *, integer *, complex *, complex + *, complex *, integer *); static real safmin; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static real safmax; - extern /* Subroutine */ int ctrexc_(char *, integer *, singlecomplex *, integer - *, singlecomplex *, integer *, integer *, integer *, integer *), + extern /* Subroutine */ int ctrexc_(char *, integer *, complex *, integer + *, complex *, integer *, integer *, integer *, integer *), cunmhr_(char *, char *, integer *, integer *, integer *, integer - *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex + *, complex *, integer *, complex *, complex *, integer *, complex *, integer *, integer *); static real smlnum; static integer lwkopt; @@ -15920,45 +15920,45 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* claqr3_ */ /* Subroutine */ int claqr4_(logical *wantt, logical *wantz, integer *n, - integer *ilo, integer *ihi, singlecomplex *h__, integer *ldh, singlecomplex *w, - integer *iloz, integer *ihiz, singlecomplex *z__, integer *ldz, singlecomplex * + integer *ilo, integer *ihi, complex *h__, integer *ldh, complex *w, + integer *iloz, integer *ihiz, complex *z__, integer *ldz, complex * work, integer *lwork, integer *info) { /* System generated locals */ integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5; real r__1, r__2, r__3, r__4, r__5, r__6, r__7, r__8; - singlecomplex q__1, q__2, q__3, q__4, q__5; + complex q__1, q__2, q__3, q__4, q__5; /* Local variables */ static integer i__, k; static real s; - static singlecomplex aa, bb, cc, dd; + static complex aa, bb, cc, dd; static integer ld, nh, it, ks, kt, ku, kv, ls, ns, nw; - static singlecomplex tr2, det; + static complex tr2, det; static integer inf, kdu, nho, nve, kwh, nsr, nwr, kwv, ndec, ndfl, kbot, nmin; - static singlecomplex swap; + static complex swap; static integer ktop; - static singlecomplex zdum[1] /* was [1][1] */; + static complex zdum[1] /* was [1][1] */; static integer kacc22, itmax, nsmax, nwmax, kwtop; extern /* Subroutine */ int claqr2_(logical *, logical *, integer *, - integer *, integer *, integer *, singlecomplex *, integer *, integer *, - integer *, singlecomplex *, integer *, integer *, integer *, singlecomplex *, - singlecomplex *, integer *, integer *, singlecomplex *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, integer *), claqr5_(logical *, + integer *, integer *, integer *, complex *, integer *, integer *, + integer *, complex *, integer *, integer *, integer *, complex *, + complex *, integer *, integer *, complex *, integer *, integer *, + complex *, integer *, complex *, integer *), claqr5_(logical *, logical *, integer *, integer *, integer *, integer *, integer *, - singlecomplex *, singlecomplex *, integer *, integer *, integer *, singlecomplex *, - integer *, singlecomplex *, integer *, singlecomplex *, integer *, integer *, - singlecomplex *, integer *, integer *, singlecomplex *, integer *); + complex *, complex *, integer *, integer *, integer *, complex *, + integer *, complex *, integer *, complex *, integer *, integer *, + complex *, integer *, integer *, complex *, integer *); static integer nibble; extern /* Subroutine */ int clahqr_(logical *, logical *, integer *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, - integer *, singlecomplex *, integer *, integer *), clacpy_(char *, - integer *, integer *, singlecomplex *, integer *, singlecomplex *, integer *); + integer *, integer *, complex *, integer *, complex *, integer *, + integer *, complex *, integer *, integer *), clacpy_(char *, + integer *, integer *, complex *, integer *, complex *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static char jbcmpz[2]; - static singlecomplex rtdisc; + static complex rtdisc; static integer nwupbd; static logical sorted; static integer lwkopt; @@ -16701,10 +16701,10 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* claqr4_ */ /* Subroutine */ int claqr5_(logical *wantt, logical *wantz, integer *kacc22, - integer *n, integer *ktop, integer *kbot, integer *nshfts, singlecomplex *s, - singlecomplex *h__, integer *ldh, integer *iloz, integer *ihiz, singlecomplex * - z__, integer *ldz, singlecomplex *v, integer *ldv, singlecomplex *u, integer *ldu, - integer *nv, singlecomplex *wv, integer *ldwv, integer *nh, singlecomplex *wh, + integer *n, integer *ktop, integer *kbot, integer *nshfts, complex *s, + complex *h__, integer *ldh, integer *iloz, integer *ihiz, complex * + z__, integer *ldz, complex *v, integer *ldv, complex *u, integer *ldu, + integer *nv, complex *wv, integer *ldwv, integer *nh, complex *wh, integer *ldwh) { /* System generated locals */ @@ -16712,39 +16712,39 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer wh_offset, wv_dim1, wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8, i__9, i__10, i__11; real r__1, r__2, r__3, r__4, r__5, r__6, r__7, r__8, r__9, r__10; - singlecomplex q__1, q__2, q__3, q__4, q__5, q__6, q__7, q__8; + complex q__1, q__2, q__3, q__4, q__5, q__6, q__7, q__8; /* Local variables */ static integer j, k, m, i2, j2, i4, j4, k1; static real h11, h12, h21, h22; static integer m22, ns, nu; - static singlecomplex vt[3]; + static complex vt[3]; static real scl; static integer kdu, kms; static real ulp; static integer knz, kzs; static real tst1, tst2; - static singlecomplex beta; + static complex beta; static logical blk22, bmp22; static integer mend, jcol, jlen, jbot, mbot, jtop, jrow, mtop; - static singlecomplex alpha; + static complex alpha; static logical accum; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *); + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *); static integer ndcol, incol, krcol, nbmps; extern /* Subroutine */ int ctrmm_(char *, char *, char *, char *, - integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, + integer *, integer *, complex *, complex *, integer *, complex *, integer *), claqr1_(integer *, - singlecomplex *, integer *, singlecomplex *, singlecomplex *, singlecomplex *), slabad_( - real *, real *), clarfg_(integer *, singlecomplex *, singlecomplex *, integer - *, singlecomplex *); + complex *, integer *, complex *, complex *, complex *), slabad_( + real *, real *), clarfg_(integer *, complex *, complex *, integer + *, complex *); extern doublereal slamch_(char *); - extern /* Subroutine */ int clacpy_(char *, integer *, integer *, singlecomplex - *, integer *, singlecomplex *, integer *), claset_(char *, - integer *, integer *, singlecomplex *, singlecomplex *, singlecomplex *, integer *); + extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex + *, integer *, complex *, integer *), claset_(char *, + integer *, integer *, complex *, complex *, complex *, integer *); static real safmin, safmax; - static singlecomplex refsum; + static complex refsum; static integer mstart; static real smlnum; @@ -18048,13 +18048,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* claqr5_ */ /* Subroutine */ int clarcm_(integer *m, integer *n, real *a, integer *lda, - singlecomplex *b, integer *ldb, singlecomplex *c__, integer *ldc, real *rwork) + complex *b, integer *ldb, complex *c__, integer *ldc, real *rwork) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5; real r__1; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, j, l; @@ -18075,8 +18075,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer CLARCM performs a very simple matrix-matrix multiplication: C := A * B, - where A is M by M and real; B is M by N and singlecomplex; - C is M by N and singlecomplex. + where A is M by M and real; B is M by N and complex; + C is M by N and complex. Arguments ========= @@ -18191,25 +18191,25 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clarcm_ */ -/* Subroutine */ int clarf_(char *side, integer *m, integer *n, singlecomplex *v, - integer *incv, singlecomplex *tau, singlecomplex *c__, integer *ldc, singlecomplex * +/* Subroutine */ int clarf_(char *side, integer *m, integer *n, complex *v, + integer *incv, complex *tau, complex *c__, integer *ldc, complex * work) { /* System generated locals */ integer c_dim1, c_offset, i__1; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__; static logical applyleft; - extern /* Subroutine */ int cgerc_(integer *, integer *, singlecomplex *, - singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, integer *), - cgemv_(char *, integer *, integer *, singlecomplex *, singlecomplex *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *); + extern /* Subroutine */ int cgerc_(integer *, integer *, complex *, + complex *, integer *, complex *, integer *, complex *, integer *), + cgemv_(char *, integer *, integer *, complex *, complex *, + integer *, complex *, integer *, complex *, complex *, integer *); extern logical lsame_(char *, char *); static integer lastc, lastv; - extern integer ilaclc_(integer *, integer *, singlecomplex *, integer *), - ilaclr_(integer *, integer *, singlecomplex *, integer *); + extern integer ilaclc_(integer *, integer *, complex *, integer *), + ilaclr_(integer *, integer *, complex *, integer *); /* @@ -18222,13 +18222,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CLARF applies a singlecomplex elementary reflector H to a singlecomplex M-by-N + CLARF applies a complex elementary reflector H to a complex M-by-N matrix C, from either the left or the right. H is represented in the form H = I - tau * v * v' - where tau is a singlecomplex scalar and v is a singlecomplex vector. + where tau is a complex scalar and v is a complex vector. If tau = 0, then H is taken to be the unit matrix. @@ -18364,30 +18364,30 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clarf_ */ /* Subroutine */ int clarfb_(char *side, char *trans, char *direct, char * - storev, integer *m, integer *n, integer *k, singlecomplex *v, integer *ldv, - singlecomplex *t, integer *ldt, singlecomplex *c__, integer *ldc, singlecomplex *work, + storev, integer *m, integer *n, integer *k, complex *v, integer *ldv, + complex *t, integer *ldt, complex *c__, integer *ldc, complex *work, integer *ldwork) { /* System generated locals */ integer c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1, work_offset, i__1, i__2, i__3, i__4, i__5; - singlecomplex q__1, q__2; + complex q__1, q__2; /* Local variables */ static integer i__, j; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *); + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *); extern logical lsame_(char *, char *); static integer lastc; - extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *), ctrmm_(char *, char *, char *, char *, - integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, + extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, + complex *, integer *), ctrmm_(char *, char *, char *, char *, + integer *, integer *, complex *, complex *, integer *, complex *, integer *); static integer lastv; - extern integer ilaclc_(integer *, integer *, singlecomplex *, integer *); - extern /* Subroutine */ int clacgv_(integer *, singlecomplex *, integer *); - extern integer ilaclr_(integer *, integer *, singlecomplex *, integer *); + extern integer ilaclc_(integer *, integer *, complex *, integer *); + extern /* Subroutine */ int clacgv_(integer *, complex *, integer *); + extern integer ilaclr_(integer *, integer *, complex *, integer *); static char transt[1]; @@ -18401,8 +18401,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CLARFB applies a singlecomplex block reflector H or its transpose H' to a - singlecomplex M-by-N matrix C, from either the left or the right. + CLARFB applies a complex block reflector H or its transpose H' to a + complex M-by-N matrix C, from either the left or the right. Arguments ========= @@ -19205,25 +19205,25 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clarfb_ */ -/* Subroutine */ int clarfg_(integer *n, singlecomplex *alpha, singlecomplex *x, integer * - incx, singlecomplex *tau) +/* Subroutine */ int clarfg_(integer *n, complex *alpha, complex *x, integer * + incx, complex *tau) { /* System generated locals */ integer i__1; real r__1, r__2; - singlecomplex q__1, q__2; + complex q__1, q__2; /* Local variables */ static integer j, knt; static real beta; - extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, + extern /* Subroutine */ int cscal_(integer *, complex *, complex *, integer *); static real alphi, alphr, xnorm; - extern doublereal scnrm2_(integer *, singlecomplex *, integer *), slapy3_(real * + extern doublereal scnrm2_(integer *, complex *, integer *), slapy3_(real * , real *, real *); - extern /* Complex */ VOID cladiv_(singlecomplex *, singlecomplex *, singlecomplex *); + extern /* Complex */ VOID cladiv_(complex *, complex *, complex *); extern doublereal slamch_(char *); - extern /* Subroutine */ int csscal_(integer *, real *, singlecomplex *, integer + extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer *); static real safmin, rsafmn; @@ -19238,19 +19238,19 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CLARFG generates a singlecomplex elementary reflector H of order n, such + CLARFG generates a complex elementary reflector H of order n, such that H' * ( alpha ) = ( beta ), H' * H = I. ( x ) ( 0 ) where alpha and beta are scalars, with beta real, and x is an - (n-1)-element singlecomplex vector. H is represented in the form + (n-1)-element complex vector. H is represented in the form H = I - tau * ( 1 ) * ( 1 v' ) , ( v ) - where tau is a singlecomplex scalar and v is a singlecomplex (n-1)-element + where tau is a complex scalar and v is a complex (n-1)-element vector. Note that H is not hermitian. If the elements of x are all zero and alpha is real, then tau = 0 @@ -19363,22 +19363,22 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clarfg_ */ /* Subroutine */ int clarft_(char *direct, char *storev, integer *n, integer * - k, singlecomplex *v, integer *ldv, singlecomplex *tau, singlecomplex *t, integer *ldt) + k, complex *v, integer *ldv, complex *tau, complex *t, integer *ldt) { /* System generated locals */ integer t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3, i__4; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, j, prevlastv; - static singlecomplex vii; - extern /* Subroutine */ int cgemv_(char *, integer *, integer *, singlecomplex * - , singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * + static complex vii; + extern /* Subroutine */ int cgemv_(char *, integer *, integer *, complex * + , complex *, integer *, complex *, integer *, complex *, complex * , integer *); extern logical lsame_(char *, char *); static integer lastv; extern /* Subroutine */ int ctrmv_(char *, char *, char *, integer *, - singlecomplex *, integer *, singlecomplex *, integer *), clacgv_(integer *, singlecomplex *, integer *); + complex *, integer *, complex *, integer *), clacgv_(integer *, complex *, integer *); /* @@ -19391,7 +19391,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CLARFT forms the triangular factor T of a singlecomplex block reflector H + CLARFT forms the triangular factor T of a complex block reflector H of order n, which is defined as a product of k elementary reflectors. If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular; @@ -19703,21 +19703,21 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clarft_ */ -/* Subroutine */ int clartg_(singlecomplex *f, singlecomplex *g, real *cs, singlecomplex *sn, - singlecomplex *r__) +/* Subroutine */ int clartg_(complex *f, complex *g, real *cs, complex *sn, + complex *r__) { /* System generated locals */ integer i__1; real r__1, r__2, r__3, r__4, r__5, r__6, r__7, r__8, r__9, r__10; - singlecomplex q__1, q__2, q__3; + complex q__1, q__2, q__3; /* Local variables */ static real d__; static integer i__; static real f2, g2; - static singlecomplex ff; + static complex ff; static real di, dr; - static singlecomplex fs, gs; + static complex fs, gs; static real f2s, g2s, eps, scale; static integer count; static real safmn2, safmx2; @@ -19850,7 +19850,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer r__3 = r_imag(g); r__1 = slapy2_(&r__2, &r__3); r__->r = r__1, r__->i = 0.f; -/* Do singlecomplex/real division explicitly with two real divisions */ +/* Do complex/real division explicitly with two real divisions */ r__1 = gs.r; r__2 = r_imag(&gs); d__ = slapy2_(&r__1, &r__2); @@ -19880,7 +19880,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer *cs = f2s / g2s; /* Make sure abs(FF) = 1 - Do singlecomplex/real division explicitly with 2 real divisions + Do complex/real division explicitly with 2 real divisions Computing MAX */ r__3 = (r__1 = f->r, dabs(r__1)), r__4 = (r__2 = r_imag(f), dabs(r__2) @@ -19922,14 +19922,14 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer */ f2s = sqrt(g2 / f2 + 1.f); -/* Do the F2S(real)*FS(singlecomplex) multiply with two real multiplies */ +/* Do the F2S(real)*FS(complex) multiply with two real multiplies */ r__1 = f2s * fs.r; r__2 = f2s * r_imag(&fs); q__1.r = r__1, q__1.i = r__2; r__->r = q__1.r, r__->i = q__1.i; *cs = 1.f / f2s; d__ = f2 + g2; -/* Do singlecomplex/real division explicitly with two real divisions */ +/* Do complex/real division explicitly with two real divisions */ r__1 = r__->r / d__; r__2 = r_imag(r__) / d__; q__1.r = r__1, q__1.i = r__2; @@ -19963,12 +19963,12 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clartg_ */ /* Subroutine */ int clascl_(char *type__, integer *kl, integer *ku, real * - cfrom, real *cto, integer *m, integer *n, singlecomplex *a, integer *lda, + cfrom, real *cto, integer *m, integer *n, complex *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, j, k1, k2, k3, k4; @@ -19996,7 +19996,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CLASCL multiplies the M by N singlecomplex matrix A by the real scalar + CLASCL multiplies the M by N complex matrix A by the real scalar CTO/CFROM. This is done without over/underflow as long as the final result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that A may be full, upper triangular, lower triangular, upper Hessenberg, @@ -20317,8 +20317,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clascl_ */ -/* Subroutine */ int claset_(char *uplo, integer *m, integer *n, singlecomplex * - alpha, singlecomplex *beta, singlecomplex *a, integer *lda) +/* Subroutine */ int claset_(char *uplo, integer *m, integer *n, complex * + alpha, complex *beta, complex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; @@ -20464,15 +20464,15 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* claset_ */ /* Subroutine */ int clasr_(char *side, char *pivot, char *direct, integer *m, - integer *n, real *c__, real *s, singlecomplex *a, integer *lda) + integer *n, real *c__, real *s, complex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; - singlecomplex q__1, q__2, q__3; + complex q__1, q__2, q__3; /* Local variables */ static integer i__, j, info; - static singlecomplex temp; + static complex temp; extern logical lsame_(char *, char *); static real ctemp, stemp; extern /* Subroutine */ int xerbla_(char *, integer *); @@ -20488,7 +20488,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CLASR applies a sequence of real plane rotations to a singlecomplex matrix + CLASR applies a sequence of real plane rotations to a complex matrix A, from either the left or the right. When SIDE = 'L', the transformation takes the form @@ -21046,7 +21046,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clasr_ */ -/* Subroutine */ int classq_(integer *n, singlecomplex *x, integer *incx, real * +/* Subroutine */ int classq_(integer *n, complex *x, integer *incx, real * scale, real *sumsq) { /* System generated locals */ @@ -21159,7 +21159,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* classq_ */ -/* Subroutine */ int claswp_(integer *n, singlecomplex *a, integer *lda, integer * +/* Subroutine */ int claswp_(integer *n, complex *a, integer *lda, integer * k1, integer *k2, integer *ipiv, integer *incx) { /* System generated locals */ @@ -21167,7 +21167,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer /* Local variables */ static integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc; - static singlecomplex temp; + static complex temp; /* @@ -21307,30 +21307,30 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* claswp_ */ -/* Subroutine */ int clatrd_(char *uplo, integer *n, integer *nb, singlecomplex *a, - integer *lda, real *e, singlecomplex *tau, singlecomplex *w, integer *ldw) +/* Subroutine */ int clatrd_(char *uplo, integer *n, integer *nb, complex *a, + integer *lda, real *e, complex *tau, complex *w, integer *ldw) { /* System generated locals */ integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3; real r__1; - singlecomplex q__1, q__2, q__3, q__4; + complex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__, iw; - static singlecomplex alpha; - extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, + static complex alpha; + extern /* Subroutine */ int cscal_(integer *, complex *, complex *, integer *); - extern /* Complex */ VOID cdotc_(singlecomplex *, integer *, singlecomplex *, integer - *, singlecomplex *, integer *); - extern /* Subroutine */ int cgemv_(char *, integer *, integer *, singlecomplex * - , singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * - , integer *), chemv_(char *, integer *, singlecomplex *, - singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, + extern /* Complex */ VOID cdotc_(complex *, integer *, complex *, integer + *, complex *, integer *); + extern /* Subroutine */ int cgemv_(char *, integer *, integer *, complex * + , complex *, integer *, complex *, integer *, complex *, complex * + , integer *), chemv_(char *, integer *, complex *, + complex *, integer *, complex *, integer *, complex *, complex *, integer *); extern logical lsame_(char *, char *); - extern /* Subroutine */ int caxpy_(integer *, singlecomplex *, singlecomplex *, - integer *, singlecomplex *, integer *), clarfg_(integer *, singlecomplex *, - singlecomplex *, integer *, singlecomplex *), clacgv_(integer *, singlecomplex *, + extern /* Subroutine */ int caxpy_(integer *, complex *, complex *, + integer *, complex *, integer *), clarfg_(integer *, complex *, + complex *, integer *, complex *), clacgv_(integer *, complex *, integer *); @@ -21344,7 +21344,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CLATRD reduces NB rows and columns of a singlecomplex Hermitian matrix A to + CLATRD reduces NB rows and columns of a complex Hermitian matrix A to Hermitian tridiagonal form by a unitary similarity transformation Q' * A * Q, and returns the matrices V and W which are needed to apply the transformation to the unreduced part of A. @@ -21425,7 +21425,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(i:n) = 0 and v(i-1) = 1; v(1:i-1) is stored on exit in A(1:i-1,i), and tau in TAU(i-1). @@ -21438,7 +21438,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer H(i) = I - tau * v * v' - where tau is a singlecomplex scalar, and v is a singlecomplex vector with + where tau is a complex scalar, and v is a complex vector with v(1:i) = 0 and v(i+1) = 1; v(i+1:n) is stored on exit in A(i+1:n,i), and tau in TAU(i). @@ -21699,13 +21699,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clatrd_ */ /* Subroutine */ int clatrs_(char *uplo, char *trans, char *diag, char * - normin, integer *n, singlecomplex *a, integer *lda, singlecomplex *x, real *scale, + normin, integer *n, complex *a, integer *lda, complex *x, real *scale, real *cnorm, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; real r__1, r__2, r__3, r__4; - singlecomplex q__1, q__2, q__3, q__4; + complex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__, j; @@ -21714,31 +21714,31 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer static real xbnd; static integer imax; static real tmax; - static singlecomplex tjjs; + static complex tjjs; static real xmax, grow; - extern /* Complex */ VOID cdotc_(singlecomplex *, integer *, singlecomplex *, integer - *, singlecomplex *, integer *); + extern /* Complex */ VOID cdotc_(complex *, integer *, complex *, integer + *, complex *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *); static real tscal; - static singlecomplex uscal; + static complex uscal; static integer jlast; - extern /* Complex */ VOID cdotu_(singlecomplex *, integer *, singlecomplex *, integer - *, singlecomplex *, integer *); - static singlecomplex csumj; - extern /* Subroutine */ int caxpy_(integer *, singlecomplex *, singlecomplex *, - integer *, singlecomplex *, integer *); + extern /* Complex */ VOID cdotu_(complex *, integer *, complex *, integer + *, complex *, integer *); + static complex csumj; + extern /* Subroutine */ int caxpy_(integer *, complex *, complex *, + integer *, complex *, integer *); static logical upper; extern /* Subroutine */ int ctrsv_(char *, char *, char *, integer *, - singlecomplex *, integer *, singlecomplex *, integer *), slabad_(real *, real *); - extern integer icamax_(integer *, singlecomplex *, integer *); - extern /* Complex */ VOID cladiv_(singlecomplex *, singlecomplex *, singlecomplex *); + complex *, integer *, complex *, integer *), slabad_(real *, real *); + extern integer icamax_(integer *, complex *, integer *); + extern /* Complex */ VOID cladiv_(complex *, complex *, complex *); extern doublereal slamch_(char *); - extern /* Subroutine */ int csscal_(integer *, real *, singlecomplex *, integer + extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); static real bignum; extern integer isamax_(integer *, real *, integer *); - extern doublereal scasum_(integer *, singlecomplex *, integer *); + extern doublereal scasum_(integer *, complex *, integer *); static logical notran; static integer jfirst; static real smlnum; @@ -22860,26 +22860,26 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clatrs_ */ -/* Subroutine */ int clauu2_(char *uplo, integer *n, singlecomplex *a, integer *lda, +/* Subroutine */ int clauu2_(char *uplo, integer *n, complex *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; real r__1; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__; static real aii; - extern /* Complex */ VOID cdotc_(singlecomplex *, integer *, singlecomplex *, integer - *, singlecomplex *, integer *); + extern /* Complex */ VOID cdotc_(complex *, integer *, complex *, integer + *, complex *, integer *); extern logical lsame_(char *, char *); - extern /* Subroutine */ int cgemv_(char *, integer *, integer *, singlecomplex * - , singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * + extern /* Subroutine */ int cgemv_(char *, integer *, integer *, complex * + , complex *, integer *, complex *, integer *, complex *, complex * , integer *); static logical upper; - extern /* Subroutine */ int clacgv_(integer *, singlecomplex *, integer *), - csscal_(integer *, real *, singlecomplex *, integer *), xerbla_(char *, + extern /* Subroutine */ int clacgv_(integer *, complex *, integer *), + csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); @@ -23032,7 +23032,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clauu2_ */ -/* Subroutine */ int clauum_(char *uplo, integer *n, singlecomplex *a, integer *lda, +/* Subroutine */ int clauum_(char *uplo, integer *n, complex *a, integer *lda, integer *info) { /* System generated locals */ @@ -23041,16 +23041,16 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer /* Local variables */ static integer i__, ib, nb; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *), cherk_(char *, - char *, integer *, integer *, real *, singlecomplex *, integer *, real * - , singlecomplex *, integer *); + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *), cherk_(char *, + char *, integer *, integer *, real *, complex *, integer *, real * + , complex *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ int ctrmm_(char *, char *, char *, char *, - integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, + integer *, integer *, complex *, complex *, integer *, complex *, integer *); static logical upper; - extern /* Subroutine */ int clauu2_(char *, integer *, singlecomplex *, integer + extern /* Subroutine */ int clauu2_(char *, integer *, complex *, integer *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -23217,26 +23217,26 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* clauum_ */ -/* Subroutine */ int cpotf2_(char *uplo, integer *n, singlecomplex *a, integer *lda, +/* Subroutine */ int cpotf2_(char *uplo, integer *n, complex *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; real r__1; - singlecomplex q__1, q__2; + complex q__1, q__2; /* Local variables */ static integer j; static real ajj; - extern /* Complex */ VOID cdotc_(singlecomplex *, integer *, singlecomplex *, integer - *, singlecomplex *, integer *); + extern /* Complex */ VOID cdotc_(complex *, integer *, complex *, integer + *, complex *, integer *); extern logical lsame_(char *, char *); - extern /* Subroutine */ int cgemv_(char *, integer *, integer *, singlecomplex * - , singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * + extern /* Subroutine */ int cgemv_(char *, integer *, integer *, complex * + , complex *, integer *, complex *, integer *, complex *, complex * , integer *); static logical upper; - extern /* Subroutine */ int clacgv_(integer *, singlecomplex *, integer *), - csscal_(integer *, real *, singlecomplex *, integer *), xerbla_(char *, + extern /* Subroutine */ int clacgv_(integer *, complex *, integer *), + csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *); extern logical sisnan_(real *); @@ -23251,7 +23251,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CPOTF2 computes the Cholesky factorization of a singlecomplex Hermitian + CPOTF2 computes the Cholesky factorization of a complex Hermitian positive definite matrix A. The factorization has the form @@ -23428,26 +23428,26 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cpotf2_ */ -/* Subroutine */ int cpotrf_(char *uplo, integer *n, singlecomplex *a, integer *lda, +/* Subroutine */ int cpotrf_(char *uplo, integer *n, complex *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer j, jb, nb; extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *, - integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *), cherk_(char *, - char *, integer *, integer *, real *, singlecomplex *, integer *, real * - , singlecomplex *, integer *); + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *), cherk_(char *, + char *, integer *, integer *, real *, complex *, integer *, real * + , complex *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ int ctrsm_(char *, char *, char *, char *, - integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, + integer *, integer *, complex *, complex *, integer *, complex *, integer *); static logical upper; - extern /* Subroutine */ int cpotf2_(char *, integer *, singlecomplex *, integer + extern /* Subroutine */ int cpotf2_(char *, integer *, complex *, integer *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -23463,7 +23463,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CPOTRF computes the Cholesky factorization of a singlecomplex Hermitian + CPOTRF computes the Cholesky factorization of a complex Hermitian positive definite matrix A. The factorization has the form @@ -23649,7 +23649,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cpotrf_ */ -/* Subroutine */ int cpotri_(char *uplo, integer *n, singlecomplex *a, integer *lda, +/* Subroutine */ int cpotri_(char *uplo, integer *n, complex *a, integer *lda, integer *info) { /* System generated locals */ @@ -23658,8 +23658,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *), clauum_( - char *, integer *, singlecomplex *, integer *, integer *), - ctrtri_(char *, char *, integer *, singlecomplex *, integer *, integer * + char *, integer *, complex *, integer *, integer *), + ctrtri_(char *, char *, integer *, complex *, integer *, integer * ); @@ -23673,7 +23673,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CPOTRI computes the inverse of a singlecomplex Hermitian positive definite + CPOTRI computes the inverse of a complex Hermitian positive definite matrix A using the Cholesky factorization A = U**H*U or A = L*L**H computed by CPOTRF. @@ -23752,8 +23752,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cpotri_ */ -/* Subroutine */ int cpotrs_(char *uplo, integer *n, integer *nrhs, singlecomplex * - a, integer *lda, singlecomplex *b, integer *ldb, integer *info) +/* Subroutine */ int cpotrs_(char *uplo, integer *n, integer *nrhs, complex * + a, integer *lda, complex *b, integer *ldb, integer *info) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, i__1; @@ -23761,7 +23761,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer /* Local variables */ extern logical lsame_(char *, char *); extern /* Subroutine */ int ctrsm_(char *, char *, char *, char *, - integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, + integer *, integer *, complex *, complex *, integer *, complex *, integer *); static logical upper; extern /* Subroutine */ int xerbla_(char *, integer *); @@ -23891,16 +23891,16 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cpotrs_ */ -/* Subroutine */ int crot_(integer *n, singlecomplex *cx, integer *incx, singlecomplex * - cy, integer *incy, real *c__, singlecomplex *s) +/* Subroutine */ int crot_(integer *n, complex *cx, integer *incx, complex * + cy, integer *incy, real *c__, complex *s) { /* System generated locals */ integer i__1, i__2, i__3, i__4; - singlecomplex q__1, q__2, q__3, q__4; + complex q__1, q__2, q__3, q__4; /* Local variables */ static integer i__, ix, iy; - static singlecomplex stemp; + static complex stemp; /* @@ -23914,7 +23914,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer ======= CROT applies a plane rotation, where the cos (C) is real and the - sin (S) is singlecomplex, and the vectors CX and CY are singlecomplex. + sin (S) is complex, and the vectors CX and CY are complex. Arguments ========= @@ -24024,7 +24024,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* crot_ */ /* Subroutine */ int cstedc_(char *compz, integer *n, real *d__, real *e, - singlecomplex *z__, integer *ldz, singlecomplex *work, integer *lwork, real * + complex *z__, integer *ldz, complex *work, integer *lwork, real * rwork, integer *lrwork, integer *iwork, integer *liwork, integer * info) { @@ -24038,18 +24038,18 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer static integer ii, ll, lgn; static real eps, tiny; extern logical lsame_(char *, char *); - extern /* Subroutine */ int cswap_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *); + extern /* Subroutine */ int cswap_(integer *, complex *, integer *, + complex *, integer *); static integer lwmin; extern /* Subroutine */ int claed0_(integer *, integer *, real *, real *, - singlecomplex *, integer *, singlecomplex *, integer *, real *, integer *, + complex *, integer *, complex *, integer *, real *, integer *, integer *); static integer start; - extern /* Subroutine */ int clacrm_(integer *, integer *, singlecomplex *, - integer *, real *, integer *, singlecomplex *, integer *, real *); + extern /* Subroutine */ int clacrm_(integer *, integer *, complex *, + integer *, real *, integer *, complex *, integer *, real *); extern doublereal slamch_(char *); - extern /* Subroutine */ int clacpy_(char *, integer *, integer *, singlecomplex - *, integer *, singlecomplex *, integer *), xerbla_(char *, + extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex + *, integer *, complex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -24060,7 +24060,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer real *, integer *); static integer liwmin, icompz; extern /* Subroutine */ int csteqr_(char *, integer *, real *, real *, - singlecomplex *, integer *, real *, integer *); + complex *, integer *, real *, integer *); static real orgnrm; extern doublereal slanst_(char *, integer *, real *, real *); extern /* Subroutine */ int ssterf_(integer *, real *, real *, integer *); @@ -24083,7 +24083,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer CSTEDC computes all eigenvalues and, optionally, eigenvectors of a symmetric tridiagonal matrix using the divide and conquer method. - The eigenvectors of a full or band singlecomplex Hermitian matrix can also + The eigenvectors of a full or band complex Hermitian matrix can also be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this matrix to tridiagonal form. @@ -24491,7 +24491,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cstedc_ */ /* Subroutine */ int csteqr_(char *compz, integer *n, real *d__, real *e, - singlecomplex *z__, integer *ldz, real *work, integer *info) + complex *z__, integer *ldz, real *work, integer *info) { /* System generated locals */ integer z_dim1, z_offset, i__1, i__2; @@ -24510,18 +24510,18 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer ; extern logical lsame_(char *, char *); extern /* Subroutine */ int clasr_(char *, char *, char *, integer *, - integer *, real *, real *, singlecomplex *, integer *); + integer *, real *, real *, complex *, integer *); static real anorm; - extern /* Subroutine */ int cswap_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *); + extern /* Subroutine */ int cswap_(integer *, complex *, integer *, + complex *, integer *); static integer lendm1, lendp1; extern /* Subroutine */ int slaev2_(real *, real *, real *, real *, real * , real *, real *); extern doublereal slapy2_(real *, real *); static integer iscale; extern doublereal slamch_(char *); - extern /* Subroutine */ int claset_(char *, integer *, integer *, singlecomplex - *, singlecomplex *, singlecomplex *, integer *); + extern /* Subroutine */ int claset_(char *, integer *, integer *, complex + *, complex *, complex *, integer *); static real safmin; extern /* Subroutine */ int xerbla_(char *, integer *); static real safmax; @@ -24549,7 +24549,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer CSTEQR computes all eigenvalues and, optionally, eigenvectors of a symmetric tridiagonal matrix using the implicit QL or QR method. - The eigenvectors of a full or band singlecomplex Hermitian matrix can also + The eigenvectors of a full or band complex Hermitian matrix can also be found if CHETRD or CHPTRD or CHBTRD has been used to reduce this matrix to tridiagonal form. @@ -25087,15 +25087,15 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* csteqr_ */ /* Subroutine */ int ctrevc_(char *side, char *howmny, logical *select, - integer *n, singlecomplex *t, integer *ldt, singlecomplex *vl, integer *ldvl, - singlecomplex *vr, integer *ldvr, integer *mm, integer *m, singlecomplex *work, + integer *n, complex *t, integer *ldt, complex *vl, integer *ldvl, + complex *vr, integer *ldvr, integer *mm, integer *m, complex *work, real *rwork, integer *info) { /* System generated locals */ integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3, i__4, i__5; real r__1, r__2, r__3; - singlecomplex q__1, q__2; + complex q__1, q__2; /* Local variables */ static integer i__, j, k, ii, ki, is; @@ -25105,21 +25105,21 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer static logical over; static real scale; extern logical lsame_(char *, char *); - extern /* Subroutine */ int cgemv_(char *, integer *, integer *, singlecomplex * - , singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * + extern /* Subroutine */ int cgemv_(char *, integer *, integer *, complex * + , complex *, integer *, complex *, integer *, complex *, complex * , integer *); static real remax; - extern /* Subroutine */ int ccopy_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *); + extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, + complex *, integer *); static logical leftv, bothv, somev; extern /* Subroutine */ int slabad_(real *, real *); - extern integer icamax_(integer *, singlecomplex *, integer *); + extern integer icamax_(integer *, complex *, integer *); extern doublereal slamch_(char *); - extern /* Subroutine */ int csscal_(integer *, real *, singlecomplex *, integer + extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer *), xerbla_(char *, integer *), clatrs_(char *, char *, - char *, char *, integer *, singlecomplex *, integer *, singlecomplex *, real * + char *, char *, integer *, complex *, integer *, complex *, real * , real *, integer *); - extern doublereal scasum_(integer *, singlecomplex *, integer *); + extern doublereal scasum_(integer *, complex *, integer *); static logical rightv; static real smlnum; @@ -25135,9 +25135,9 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer ======= CTREVC computes some or all of the right and/or left eigenvectors of - a singlecomplex upper triangular matrix T. + a complex upper triangular matrix T. Matrices of this type are produced by the Schur factorization of - a singlecomplex general matrix: A = Q*T*Q**H, as computed by CHSEQR. + a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. The right eigenvector x and the left eigenvector y of T corresponding to an eigenvalue w are defined by: @@ -25246,7 +25246,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer possible overflow. Each eigenvector is normalized so that the element of largest - magnitude has magnitude 1; here the magnitude of a singlecomplex number + magnitude has magnitude 1; here the magnitude of a complex number (x,y) is taken to be |x| + |y|. ===================================================================== @@ -25587,24 +25587,24 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* ctrevc_ */ -/* Subroutine */ int ctrexc_(char *compq, integer *n, singlecomplex *t, integer * - ldt, singlecomplex *q, integer *ldq, integer *ifst, integer *ilst, integer * +/* Subroutine */ int ctrexc_(char *compq, integer *n, complex *t, integer * + ldt, complex *q, integer *ldq, integer *ifst, integer *ilst, integer * info) { /* System generated locals */ integer q_dim1, q_offset, t_dim1, t_offset, i__1, i__2, i__3; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer k, m1, m2, m3; static real cs; - static singlecomplex t11, t22, sn, temp; - extern /* Subroutine */ int crot_(integer *, singlecomplex *, integer *, - singlecomplex *, integer *, real *, singlecomplex *); + static complex t11, t22, sn, temp; + extern /* Subroutine */ int crot_(integer *, complex *, integer *, + complex *, integer *, real *, complex *); extern logical lsame_(char *, char *); static logical wantq; - extern /* Subroutine */ int clartg_(singlecomplex *, singlecomplex *, real *, singlecomplex - *, singlecomplex *), xerbla_(char *, integer *); + extern /* Subroutine */ int clartg_(complex *, complex *, real *, complex + *, complex *), xerbla_(char *, integer *); /* @@ -25617,7 +25617,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CTREXC reorders the Schur factorization of a singlecomplex matrix + CTREXC reorders the Schur factorization of a complex matrix A = Q*T*Q**H, so that the diagonal element of T with row index IFST is moved to row ILST. @@ -25771,22 +25771,22 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* ctrexc_ */ -/* Subroutine */ int ctrti2_(char *uplo, char *diag, integer *n, singlecomplex *a, +/* Subroutine */ int ctrti2_(char *uplo, char *diag, integer *n, complex *a, integer *lda, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer j; - static singlecomplex ajj; - extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, + static complex ajj; + extern /* Subroutine */ int cscal_(integer *, complex *, complex *, integer *); extern logical lsame_(char *, char *); static logical upper; extern /* Subroutine */ int ctrmv_(char *, char *, char *, integer *, - singlecomplex *, integer *, singlecomplex *, integer *), xerbla_(char *, integer *); + complex *, integer *, complex *, integer *), xerbla_(char *, integer *); static logical nounit; @@ -25800,7 +25800,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CTRTI2 computes the inverse of a singlecomplex upper or lower triangular + CTRTI2 computes the inverse of a complex upper or lower triangular matrix. This is the Level 2 BLAS version of the algorithm. @@ -25935,25 +25935,25 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* ctrti2_ */ -/* Subroutine */ int ctrtri_(char *uplo, char *diag, integer *n, singlecomplex *a, +/* Subroutine */ int ctrtri_(char *uplo, char *diag, integer *n, complex *a, integer *lda, integer *info) { /* System generated locals */ address a__1[2]; integer a_dim1, a_offset, i__1, i__2, i__3[2], i__4, i__5; - singlecomplex q__1; + complex q__1; char ch__1[2]; /* Local variables */ static integer j, jb, nb, nn; extern logical lsame_(char *, char *); extern /* Subroutine */ int ctrmm_(char *, char *, char *, char *, - integer *, integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *, + integer *, integer *, complex *, complex *, integer *, complex *, integer *), ctrsm_(char *, char *, - char *, char *, integer *, integer *, singlecomplex *, singlecomplex *, - integer *, singlecomplex *, integer *); + char *, char *, integer *, integer *, complex *, complex *, + integer *, complex *, integer *); static logical upper; - extern /* Subroutine */ int ctrti2_(char *, char *, integer *, singlecomplex *, + extern /* Subroutine */ int ctrti2_(char *, char *, integer *, complex *, integer *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -25970,7 +25970,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CTRTRI computes the inverse of a singlecomplex upper or lower triangular + CTRTRI computes the inverse of a complex upper or lower triangular matrix A. This is the Level 3 BLAS version of the algorithm. @@ -26146,18 +26146,18 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* ctrtri_ */ -/* Subroutine */ int cung2r_(integer *m, integer *n, integer *k, singlecomplex *a, - integer *lda, singlecomplex *tau, singlecomplex *work, integer *info) +/* Subroutine */ int cung2r_(integer *m, integer *n, integer *k, complex *a, + integer *lda, complex *tau, complex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, j, l; - extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, - integer *), clarf_(char *, integer *, integer *, singlecomplex *, - integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), + extern /* Subroutine */ int cscal_(integer *, complex *, complex *, + integer *), clarf_(char *, integer *, integer *, complex *, + integer *, complex *, complex *, integer *, complex *), xerbla_(char *, integer *); @@ -26171,7 +26171,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNG2R generates an m by n singlecomplex matrix Q with orthonormal columns, + CUNG2R generates an m by n complex matrix Q with orthonormal columns, which is defined as the first n columns of a product of k elementary reflectors of order m @@ -26303,7 +26303,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cung2r_ */ /* Subroutine */ int cungbr_(char *vect, integer *m, integer *n, integer *k, - singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *work, integer *lwork, + complex *a, integer *lda, complex *tau, complex *work, integer *lwork, integer *info) { /* System generated locals */ @@ -26318,9 +26318,9 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int cunglq_(integer *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer *), - cungqr_(integer *, integer *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *, integer *); + complex *, integer *, complex *, complex *, integer *, integer *), + cungqr_(integer *, integer *, integer *, complex *, integer *, + complex *, complex *, integer *, integer *); static integer lwkopt; static logical lquery; @@ -26335,8 +26335,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNGBR generates one of the singlecomplex unitary matrices Q or P**H - determined by CGEBRD when reducing a singlecomplex matrix A to bidiagonal + CUNGBR generates one of the complex unitary matrices Q or P**H + determined by CGEBRD when reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q and P**H are defined as products of elementary reflectors H(i) or G(i) respectively. @@ -26590,8 +26590,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cungbr_ */ -/* Subroutine */ int cunghr_(integer *n, integer *ilo, integer *ihi, singlecomplex * - a, integer *lda, singlecomplex *tau, singlecomplex *work, integer *lwork, integer +/* Subroutine */ int cunghr_(integer *n, integer *ilo, integer *ihi, complex * + a, integer *lda, complex *tau, complex *work, integer *lwork, integer *info) { /* System generated locals */ @@ -26603,7 +26603,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int cungqr_(integer *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, integer *); + complex *, integer *, complex *, complex *, integer *, integer *); static integer lwkopt; static logical lquery; @@ -26618,7 +26618,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNGHR generates a singlecomplex unitary matrix Q which is defined as the + CUNGHR generates a complex unitary matrix Q which is defined as the product of IHI-ILO elementary reflectors of order N, as returned by CGEHRD: @@ -26785,19 +26785,19 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cunghr_ */ -/* Subroutine */ int cungl2_(integer *m, integer *n, integer *k, singlecomplex *a, - integer *lda, singlecomplex *tau, singlecomplex *work, integer *info) +/* Subroutine */ int cungl2_(integer *m, integer *n, integer *k, complex *a, + integer *lda, complex *tau, complex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3; - singlecomplex q__1, q__2; + complex q__1, q__2; /* Local variables */ static integer i__, j, l; - extern /* Subroutine */ int cscal_(integer *, singlecomplex *, singlecomplex *, - integer *), clarf_(char *, integer *, integer *, singlecomplex *, - integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *), - clacgv_(integer *, singlecomplex *, integer *), xerbla_(char *, integer + extern /* Subroutine */ int cscal_(integer *, complex *, complex *, + integer *), clarf_(char *, integer *, integer *, complex *, + integer *, complex *, complex *, integer *, complex *), + clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); @@ -26811,7 +26811,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNGL2 generates an m-by-n singlecomplex matrix Q with orthonormal rows, + CUNGL2 generates an m-by-n complex matrix Q with orthonormal rows, which is defined as the first m rows of a product of k elementary reflectors of order n @@ -26951,8 +26951,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cungl2_ */ -/* Subroutine */ int cunglq_(integer *m, integer *n, integer *k, singlecomplex *a, - integer *lda, singlecomplex *tau, singlecomplex *work, integer *lwork, integer * +/* Subroutine */ int cunglq_(integer *m, integer *n, integer *k, complex *a, + integer *lda, complex *tau, complex *work, integer *lwork, integer * info) { /* System generated locals */ @@ -26961,12 +26961,12 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer /* Local variables */ static integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ int cungl2_(integer *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *), clarfb_( + complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, - singlecomplex *, integer *), clarft_( - char *, char *, integer *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *), xerbla_(char *, + complex *, integer *, complex *, integer *, complex *, integer *, + complex *, integer *), clarft_( + char *, char *, integer *, integer *, complex *, integer *, + complex *, complex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -26984,7 +26984,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNGLQ generates an M-by-N singlecomplex matrix Q with orthonormal rows, + CUNGLQ generates an M-by-N complex matrix Q with orthonormal rows, which is defined as the first M rows of a product of K elementary reflectors of order N @@ -27212,8 +27212,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cunglq_ */ -/* Subroutine */ int cungqr_(integer *m, integer *n, integer *k, singlecomplex *a, - integer *lda, singlecomplex *tau, singlecomplex *work, integer *lwork, integer * +/* Subroutine */ int cungqr_(integer *m, integer *n, integer *k, complex *a, + integer *lda, complex *tau, complex *work, integer *lwork, integer * info) { /* System generated locals */ @@ -27222,12 +27222,12 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer /* Local variables */ static integer i__, j, l, ib, nb, ki, kk, nx, iws, nbmin, iinfo; extern /* Subroutine */ int cung2r_(integer *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *), clarfb_( + complex *, integer *, complex *, complex *, integer *), clarfb_( char *, char *, char *, char *, integer *, integer *, integer *, - singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, integer *, - singlecomplex *, integer *), clarft_( - char *, char *, integer *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *), xerbla_(char *, + complex *, integer *, complex *, integer *, complex *, integer *, + complex *, integer *), clarft_( + char *, char *, integer *, integer *, complex *, integer *, + complex *, complex *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -27245,7 +27245,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNGQR generates an M-by-N singlecomplex matrix Q with orthonormal columns, + CUNGQR generates an M-by-N complex matrix Q with orthonormal columns, which is defined as the first N columns of a product of K elementary reflectors of order M @@ -27475,20 +27475,20 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cungqr_ */ /* Subroutine */ int cunm2l_(char *side, char *trans, integer *m, integer *n, - integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, - integer *ldc, singlecomplex *work, integer *info) + integer *k, complex *a, integer *lda, complex *tau, complex *c__, + integer *ldc, complex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, i1, i2, i3, mi, ni, nq; - static singlecomplex aii; + static complex aii; static logical left; - static singlecomplex taui; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * - , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *); + static complex taui; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * + , integer *, complex *, complex *, integer *, complex *); extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); static logical notran; @@ -27504,7 +27504,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNM2L overwrites the general singlecomplex m-by-n matrix C with + CUNM2L overwrites the general complex m-by-n matrix C with Q * C if SIDE = 'L' and TRANS = 'N', or @@ -27514,7 +27514,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer C * Q' if SIDE = 'R' and TRANS = 'C', - where Q is a singlecomplex unitary matrix defined as the product of k + where Q is a complex unitary matrix defined as the product of k elementary reflectors Q = H(k) . . . H(2) H(1) @@ -27687,20 +27687,20 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cunm2l_ */ /* Subroutine */ int cunm2r_(char *side, char *trans, integer *m, integer *n, - integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, - integer *ldc, singlecomplex *work, integer *info) + integer *k, complex *a, integer *lda, complex *tau, complex *c__, + integer *ldc, complex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, i1, i2, i3, ic, jc, mi, ni, nq; - static singlecomplex aii; + static complex aii; static logical left; - static singlecomplex taui; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * - , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *); + static complex taui; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * + , integer *, complex *, complex *, integer *, complex *); extern logical lsame_(char *, char *); extern /* Subroutine */ int xerbla_(char *, integer *); static logical notran; @@ -27716,7 +27716,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNM2R overwrites the general singlecomplex m-by-n matrix C with + CUNM2R overwrites the general complex m-by-n matrix C with Q * C if SIDE = 'L' and TRANS = 'N', or @@ -27726,7 +27726,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer C * Q' if SIDE = 'R' and TRANS = 'C', - where Q is a singlecomplex unitary matrix defined as the product of k + where Q is a complex unitary matrix defined as the product of k elementary reflectors Q = H(1) H(2) . . . H(k) @@ -27903,8 +27903,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cunm2r_ */ /* Subroutine */ int cunmbr_(char *vect, char *side, char *trans, integer *m, - integer *n, integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, - singlecomplex *c__, integer *ldc, singlecomplex *work, integer *lwork, integer * + integer *n, integer *k, complex *a, integer *lda, complex *tau, + complex *c__, integer *ldc, complex *work, integer *lwork, integer * info) { /* System generated locals */ @@ -27921,12 +27921,12 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int cunmlq_(char *, char *, integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *, integer *); + integer *, complex *, integer *, complex *, complex *, integer *, + complex *, integer *, integer *); static logical notran; extern /* Subroutine */ int cunmqr_(char *, char *, integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *, integer *); + integer *, complex *, integer *, complex *, complex *, integer *, + complex *, integer *, integer *); static logical applyq; static char transt[1]; static integer lwkopt; @@ -27943,20 +27943,20 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - If VECT = 'Q', CUNMBR overwrites the general singlecomplex M-by-N matrix C + If VECT = 'Q', CUNMBR overwrites the general complex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C C * Q TRANS = 'C': Q**H * C C * Q**H - If VECT = 'P', CUNMBR overwrites the general singlecomplex M-by-N matrix C + If VECT = 'P', CUNMBR overwrites the general complex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': P * C C * P TRANS = 'C': P**H * C C * P**H Here Q and P**H are the unitary matrices determined by CGEBRD when - reducing a singlecomplex matrix A to bidiagonal form: A = Q * B * P**H. Q + reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q and P**H are defined as products of elementary reflectors H(i) and G(i) respectively. @@ -28243,8 +28243,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cunmbr_ */ /* Subroutine */ int cunmhr_(char *side, char *trans, integer *m, integer *n, - integer *ilo, integer *ihi, singlecomplex *a, integer *lda, singlecomplex *tau, - singlecomplex *c__, integer *ldc, singlecomplex *work, integer *lwork, integer * + integer *ilo, integer *ihi, complex *a, integer *lda, complex *tau, + complex *c__, integer *ldc, complex *work, integer *lwork, integer * info) { /* System generated locals */ @@ -28261,8 +28261,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int cunmqr_(char *, char *, integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *, integer *); + integer *, complex *, integer *, complex *, complex *, integer *, + complex *, integer *, integer *); static integer lwkopt; static logical lquery; @@ -28277,13 +28277,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNMHR overwrites the general singlecomplex M-by-N matrix C with + CUNMHR overwrites the general complex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C C * Q TRANS = 'C': Q**H * C C * Q**H - where Q is a singlecomplex unitary matrix of order nq, with nq = m if + where Q is a complex unitary matrix of order nq, with nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of IHI-ILO elementary reflectors, as returned by CGEHRD: @@ -28469,22 +28469,22 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cunmhr_ */ /* Subroutine */ int cunml2_(char *side, char *trans, integer *m, integer *n, - integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, - integer *ldc, singlecomplex *work, integer *info) + integer *k, complex *a, integer *lda, complex *tau, complex *c__, + integer *ldc, complex *work, integer *info) { /* System generated locals */ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3; - singlecomplex q__1; + complex q__1; /* Local variables */ static integer i__, i1, i2, i3, ic, jc, mi, ni, nq; - static singlecomplex aii; + static complex aii; static logical left; - static singlecomplex taui; - extern /* Subroutine */ int clarf_(char *, integer *, integer *, singlecomplex * - , integer *, singlecomplex *, singlecomplex *, integer *, singlecomplex *); + static complex taui; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * + , integer *, complex *, complex *, integer *, complex *); extern logical lsame_(char *, char *); - extern /* Subroutine */ int clacgv_(integer *, singlecomplex *, integer *), + extern /* Subroutine */ int clacgv_(integer *, complex *, integer *), xerbla_(char *, integer *); static logical notran; @@ -28499,7 +28499,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNML2 overwrites the general singlecomplex m-by-n matrix C with + CUNML2 overwrites the general complex m-by-n matrix C with Q * C if SIDE = 'L' and TRANS = 'N', or @@ -28509,7 +28509,7 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer C * Q' if SIDE = 'R' and TRANS = 'C', - where Q is a singlecomplex unitary matrix defined as the product of k + where Q is a complex unitary matrix defined as the product of k elementary reflectors Q = H(k)' . . . H(2)' H(1)' @@ -28694,8 +28694,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cunml2_ */ /* Subroutine */ int cunmlq_(char *side, char *trans, integer *m, integer *n, - integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, - integer *ldc, singlecomplex *work, integer *lwork, integer *info) + integer *k, complex *a, integer *lda, complex *tau, complex *c__, + integer *ldc, complex *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; @@ -28705,18 +28705,18 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer /* Local variables */ static integer i__; - static singlecomplex t[4160] /* was [65][64] */; + static complex t[4160] /* was [65][64] */; static integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws; static logical left; extern logical lsame_(char *, char *); static integer nbmin, iinfo; extern /* Subroutine */ int cunml2_(char *, char *, integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *), clarfb_(char *, char *, - char *, char *, integer *, integer *, integer *, singlecomplex *, - integer *, singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, + integer *, complex *, integer *, complex *, complex *, integer *, + complex *, integer *), clarfb_(char *, char *, + char *, char *, integer *, integer *, integer *, complex *, + integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char * - , integer *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * + , integer *, integer *, complex *, integer *, complex *, complex * , integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -28737,13 +28737,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNMLQ overwrites the general singlecomplex M-by-N matrix C with + CUNMLQ overwrites the general complex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C C * Q TRANS = 'C': Q**H * C C * Q**H - where Q is a singlecomplex unitary matrix defined as the product of k + where Q is a complex unitary matrix defined as the product of k elementary reflectors Q = H(k)' . . . H(2)' H(1)' @@ -28999,8 +28999,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cunmlq_ */ /* Subroutine */ int cunmql_(char *side, char *trans, integer *m, integer *n, - integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, - integer *ldc, singlecomplex *work, integer *lwork, integer *info) + integer *k, complex *a, integer *lda, complex *tau, complex *c__, + integer *ldc, complex *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; @@ -29010,18 +29010,18 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer /* Local variables */ static integer i__; - static singlecomplex t[4160] /* was [65][64] */; + static complex t[4160] /* was [65][64] */; static integer i1, i2, i3, ib, nb, mi, ni, nq, nw, iws; static logical left; extern logical lsame_(char *, char *); static integer nbmin, iinfo; extern /* Subroutine */ int cunm2l_(char *, char *, integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *), clarfb_(char *, char *, - char *, char *, integer *, integer *, integer *, singlecomplex *, - integer *, singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, + integer *, complex *, integer *, complex *, complex *, integer *, + complex *, integer *), clarfb_(char *, char *, + char *, char *, integer *, integer *, integer *, complex *, + integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char * - , integer *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * + , integer *, integer *, complex *, integer *, complex *, complex * , integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -29040,13 +29040,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNMQL overwrites the general singlecomplex M-by-N matrix C with + CUNMQL overwrites the general complex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C C * Q TRANS = 'C': Q**H * C C * Q**H - where Q is a singlecomplex unitary matrix defined as the product of k + where Q is a complex unitary matrix defined as the product of k elementary reflectors Q = H(k) . . . H(2) H(1) @@ -29297,8 +29297,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cunmql_ */ /* Subroutine */ int cunmqr_(char *side, char *trans, integer *m, integer *n, - integer *k, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, - integer *ldc, singlecomplex *work, integer *lwork, integer *info) + integer *k, complex *a, integer *lda, complex *tau, complex *c__, + integer *ldc, complex *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; @@ -29308,18 +29308,18 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer /* Local variables */ static integer i__; - static singlecomplex t[4160] /* was [65][64] */; + static complex t[4160] /* was [65][64] */; static integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws; static logical left; extern logical lsame_(char *, char *); static integer nbmin, iinfo; extern /* Subroutine */ int cunm2r_(char *, char *, integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *), clarfb_(char *, char *, - char *, char *, integer *, integer *, integer *, singlecomplex *, - integer *, singlecomplex *, integer *, singlecomplex *, integer *, singlecomplex *, + integer *, complex *, integer *, complex *, complex *, integer *, + complex *, integer *), clarfb_(char *, char *, + char *, char *, integer *, integer *, integer *, complex *, + integer *, complex *, integer *, complex *, integer *, complex *, integer *), clarft_(char *, char * - , integer *, integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex * + , integer *, integer *, complex *, integer *, complex *, complex * , integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); @@ -29338,13 +29338,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNMQR overwrites the general singlecomplex M-by-N matrix C with + CUNMQR overwrites the general complex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C C * Q TRANS = 'C': Q**H * C C * Q**H - where Q is a singlecomplex unitary matrix defined as the product of k + where Q is a complex unitary matrix defined as the product of k elementary reflectors Q = H(1) H(2) . . . H(k) @@ -29595,8 +29595,8 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer } /* cunmqr_ */ /* Subroutine */ int cunmtr_(char *side, char *uplo, char *trans, integer *m, - integer *n, singlecomplex *a, integer *lda, singlecomplex *tau, singlecomplex *c__, - integer *ldc, singlecomplex *work, integer *lwork, integer *info) + integer *n, complex *a, integer *lda, complex *tau, complex *c__, + integer *ldc, complex *work, integer *lwork, integer *info) { /* System generated locals */ address a__1[2]; @@ -29613,10 +29613,10 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int cunmql_(char *, char *, integer *, integer *, - integer *, singlecomplex *, integer *, singlecomplex *, singlecomplex *, integer *, - singlecomplex *, integer *, integer *), cunmqr_(char *, - char *, integer *, integer *, integer *, singlecomplex *, integer *, - singlecomplex *, singlecomplex *, integer *, singlecomplex *, integer *, integer *); + integer *, complex *, integer *, complex *, complex *, integer *, + complex *, integer *, integer *), cunmqr_(char *, + char *, integer *, integer *, integer *, complex *, integer *, + complex *, complex *, integer *, complex *, integer *, integer *); static integer lwkopt; static logical lquery; @@ -29631,13 +29631,13 @@ doublereal clanhe_(char *norm, char *uplo, integer *n, singlecomplex *a, integer Purpose ======= - CUNMTR overwrites the general singlecomplex M-by-N matrix C with + CUNMTR overwrites the general complex M-by-N matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C C * Q TRANS = 'C': Q**H * C C * Q**H - where Q is a singlecomplex unitary matrix of order nq, with nq = m if + where Q is a complex unitary matrix of order nq, with nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of nq-1 elementary reflectors, as returned by CHETRD: diff --git a/numpy/linalg/lapack_lite/f2c_lapack.c b/numpy/linalg/lapack_lite/f2c_lapack.c index 47540b37edc0..752261044bf8 100644 --- a/numpy/linalg/lapack_lite/f2c_lapack.c +++ b/numpy/linalg/lapack_lite/f2c_lapack.c @@ -183,7 +183,7 @@ integer ieeeck_(integer *ispec, real *zero, real *one) return ret_val; } /* ieeeck_ */ -integer ilaclc_(integer *m, integer *n, singlecomplex *a, integer *lda) +integer ilaclc_(integer *m, integer *n, complex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, ret_val, i__1, i__2; @@ -256,7 +256,7 @@ integer ilaclc_(integer *m, integer *n, singlecomplex *a, integer *lda) return ret_val; } /* ilaclc_ */ -integer ilaclr_(integer *m, integer *n, singlecomplex *a, integer *lda) +integer ilaclr_(integer *m, integer *n, complex *a, integer *lda) { /* System generated locals */ integer a_dim1, a_offset, ret_val, i__1, i__2; From 21187383cfe7bedacdba5e531402202adb504204 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Wed, 12 Jul 2023 13:57:36 +0200 Subject: [PATCH 26/40] Necessary changes for complex not to be a reserved keyword --- numpy/core/include/numpy/npy_common.h | 20 +++++++++----------- numpy/core/src/multiarray/arraytypes.c.src | 1 - numpy/core/src/multiarray/buffer.c | 10 +++++----- 3 files changed, 14 insertions(+), 17 deletions(-) diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index e6abc92485c4..0d932bfff7c8 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -363,14 +363,6 @@ typedef double npy_double; typedef Py_hash_t npy_hash_t; #define NPY_SIZEOF_HASH_T NPY_SIZEOF_INTP -#ifdef __cplusplus -extern "C++" { -#include -} -#else -#include -#endif - #if NPY_SIZEOF_COMPLEX_DOUBLE != 2 * NPY_SIZEOF_DOUBLE #error npy_cdouble definition is not compatible with C99 complex definition ! \ Please contact NumPy maintainers and give detailed information about your \ @@ -389,6 +381,7 @@ extern "C++" { #if !defined(__cplusplus) && defined(_MSC_VER) && !defined(__INTEL_COMPILER) +#include typedef _Dcomplex npy_cdouble; typedef _Fcomplex npy_cfloat; typedef _Lcomplex npy_clongdouble; @@ -396,6 +389,9 @@ typedef _Lcomplex npy_clongdouble; #define NPY_CFLOAT_INIT(real, imag) (_FCbuild((float) (real), (float) (imag))) #define NPY_CLONGDOUBLE_INIT(real, imag) (_LCbuild((longdouble_t) (real), (longdouble_t) (imag))) #elif defined(__cplusplus) /* && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ +extern "C++" { +#include +} typedef std::complex npy_cdouble; typedef std::complex npy_cfloat; typedef std::complex npy_clongdouble; @@ -403,9 +399,11 @@ typedef std::complex npy_clongdouble; #define NPY_CFLOAT_INIT(real, imag) (std::complex((float) (real), (float) (imag))) #define NPY_CLONGDOUBLE_INIT(real, imag) (std::complex((longdouble_t) (real), (longdouble_t) (imag))) #else /* !defined(__cplusplus) && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ -typedef complex double npy_cdouble; -typedef complex float npy_cfloat; -typedef complex longdouble_t npy_clongdouble; +#include +#undef complex +typedef double _Complex npy_cdouble; +typedef float _Complex npy_cfloat; +typedef longdouble_t _Complex npy_clongdouble; #define NPY_CDOUBLE_INIT(real, imag) ((double) (real) + _Complex_I * (double) (imag)) #define NPY_CFLOAT_INIT(real, imag) ((float) (real) + _Complex_I * (float) (imag)) #define NPY_CLONGDOUBLE_INIT(real, imag) ((longdouble_t) (real) + _Complex_I * (longdouble_t) (imag)) diff --git a/numpy/core/src/multiarray/arraytypes.c.src b/numpy/core/src/multiarray/arraytypes.c.src index af0802aefe6e..c85d0c1c332d 100644 --- a/numpy/core/src/multiarray/arraytypes.c.src +++ b/numpy/core/src/multiarray/arraytypes.c.src @@ -2,7 +2,6 @@ #define PY_SSIZE_T_CLEAN #include #include -#include #include #include diff --git a/numpy/core/src/multiarray/buffer.c b/numpy/core/src/multiarray/buffer.c index 4a5158bad1a7..c9d881e164fb 100644 --- a/numpy/core/src/multiarray/buffer.c +++ b/numpy/core/src/multiarray/buffer.c @@ -903,7 +903,7 @@ static int _descriptor_from_pep3118_format_fast(char const *s, PyObject **result); static int -_pep3118_letter_to_type(char letter, int native, int _complex); +_pep3118_letter_to_type(char letter, int native, int complex); NPY_NO_EXPORT PyArray_Descr* _descriptor_from_pep3118_format(char const *s) @@ -1066,7 +1066,7 @@ _descriptor_from_pep3118_format_fast(char const *s, PyObject **result) } static int -_pep3118_letter_to_type(char letter, int native, int _complex) +_pep3118_letter_to_type(char letter, int native, int complex) { switch (letter) { @@ -1082,9 +1082,9 @@ _pep3118_letter_to_type(char letter, int native, int _complex) case 'q': return native ? NPY_LONGLONG : NPY_INT64; case 'Q': return native ? NPY_ULONGLONG : NPY_UINT64; case 'e': return NPY_HALF; - case 'f': return _complex ? NPY_CFLOAT : NPY_FLOAT; - case 'd': return _complex ? NPY_CDOUBLE : NPY_DOUBLE; - case 'g': return native ? (_complex ? NPY_CLONGDOUBLE : NPY_LONGDOUBLE) : -1; + case 'f': return complex ? NPY_CFLOAT : NPY_FLOAT; + case 'd': return complex ? NPY_CDOUBLE : NPY_DOUBLE; + case 'g': return native ? (complex ? NPY_CLONGDOUBLE : NPY_LONGDOUBLE) : -1; default: /* Other unhandled cases */ return -1; From 8c77d69a1bab0b27b9f7b235a9df322ef06b1255 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Wed, 12 Jul 2023 18:37:07 +0200 Subject: [PATCH 27/40] Move complex utilities to npy_math.h [wheel build] --- numpy/core/include/numpy/npy_common.h | 158 ----------------- numpy/core/include/numpy/npy_math.h | 162 ++++++++++++++++++ numpy/core/src/common/cblasfuncs.c | 1 + .../src/multiarray/textreading/conversions.c | 1 + numpy/core/src/npysort/npysort_common.h | 1 + numpy/core/src/umath/scalarmath.c.src | 1 + numpy/f2py/cfuncs.py | 5 +- 7 files changed, 169 insertions(+), 160 deletions(-) diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index 0d932bfff7c8..b064bae233a1 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -385,9 +385,6 @@ typedef Py_hash_t npy_hash_t; typedef _Dcomplex npy_cdouble; typedef _Fcomplex npy_cfloat; typedef _Lcomplex npy_clongdouble; -#define NPY_CDOUBLE_INIT(real, imag) (_Cbuild((double) (real), (double) (imag))) -#define NPY_CFLOAT_INIT(real, imag) (_FCbuild((float) (real), (float) (imag))) -#define NPY_CLONGDOUBLE_INIT(real, imag) (_LCbuild((longdouble_t) (real), (longdouble_t) (imag))) #elif defined(__cplusplus) /* && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ extern "C++" { #include @@ -395,169 +392,14 @@ extern "C++" { typedef std::complex npy_cdouble; typedef std::complex npy_cfloat; typedef std::complex npy_clongdouble; -#define NPY_CDOUBLE_INIT(real, imag) (std::complex((double) (real), (double) (imag))) -#define NPY_CFLOAT_INIT(real, imag) (std::complex((float) (real), (float) (imag))) -#define NPY_CLONGDOUBLE_INIT(real, imag) (std::complex((longdouble_t) (real), (longdouble_t) (imag))) #else /* !defined(__cplusplus) && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ #include #undef complex typedef double _Complex npy_cdouble; typedef float _Complex npy_cfloat; typedef longdouble_t _Complex npy_clongdouble; -#define NPY_CDOUBLE_INIT(real, imag) ((double) (real) + _Complex_I * (double) (imag)) -#define NPY_CFLOAT_INIT(real, imag) ((float) (real) + _Complex_I * (float) (imag)) -#define NPY_CLONGDOUBLE_INIT(real, imag) ((longdouble_t) (real) + _Complex_I * (longdouble_t) (imag)) #endif -#ifndef __cplusplus -typedef union { - double arr[2]; - npy_cdouble comp; -} _npy_cdouble_to_arr; - -typedef union { - float arr[2]; - npy_cfloat comp; -} _npy_cfloat_to_arr; - -typedef union { - longdouble_t arr[2]; - npy_clongdouble comp; -} _npy_clongdouble_to_arr; -#endif - -static inline double NPY_CDOUBLE_GET_REAL(const npy_cdouble *c) { -#ifdef __cplusplus - return reinterpret_cast(c)[0]; -#else - _npy_cdouble_to_arr tmp; - tmp.comp = *c; - return tmp.arr[0]; -#endif -} - -static inline double NPY_CDOUBLE_GET_IMAG(const npy_cdouble *c) { -#ifdef __cplusplus - return reinterpret_cast(c)[1]; -#else - _npy_cdouble_to_arr tmp; - tmp.comp = *c; - return tmp.arr[1]; -#endif -} - -static inline void NPY_CDOUBLE_SET_REAL(npy_cdouble *c, double real) { -#ifdef __cplusplus - double *tmp = reinterpret_cast(c); - tmp[0] = real; -#else - _npy_cdouble_to_arr tmp; - tmp.comp = *c; - tmp.arr[0] = real; - *c = tmp.comp; -#endif -} - -static inline void NPY_CDOUBLE_SET_IMAG(npy_cdouble *c, double imag) { -#ifdef __cplusplus - double *tmp = reinterpret_cast(c); - tmp[1] = imag; -#else - _npy_cdouble_to_arr tmp; - tmp.comp = *c; - tmp.arr[1] = imag; - *c = tmp.comp; -#endif -} - -static inline float NPY_CFLOAT_GET_REAL(const npy_cfloat *c) { -#ifdef __cplusplus - return reinterpret_cast(c)[0]; -#else - _npy_cfloat_to_arr tmp; - tmp.comp = *c; - return tmp.arr[0]; -#endif -} - -static inline float NPY_CFLOAT_GET_IMAG(const npy_cfloat *c) { -#ifdef __cplusplus - return reinterpret_cast(c)[1]; -#else - _npy_cfloat_to_arr tmp; - tmp.comp = *c; - return tmp.arr[1]; -#endif -} - -static inline void NPY_CFLOAT_SET_REAL(npy_cfloat *c, float real) { -#ifdef __cplusplus - float *tmp = reinterpret_cast(c); - tmp[0] = real; -#else - _npy_cfloat_to_arr tmp; - tmp.comp = *c; - tmp.arr[0] = real; - *c = tmp.comp; -#endif -} - -static inline void NPY_CFLOAT_SET_IMAG(npy_cfloat *c, float imag) { -#ifdef __cplusplus - float *tmp = reinterpret_cast(c); - tmp[1] = imag; -#else - _npy_cfloat_to_arr tmp; - tmp.comp = *c; - tmp.arr[1] = imag; - *c = tmp.comp; -#endif -} - -static inline longdouble_t NPY_CLONGDOUBLE_GET_REAL(const npy_clongdouble *c) { -#ifdef __cplusplus - return reinterpret_cast(c)[0]; -#else - _npy_clongdouble_to_arr tmp; - tmp.comp = *c; - return tmp.arr[0]; -#endif -} - -static inline longdouble_t NPY_CLONGDOUBLE_GET_IMAG(const npy_clongdouble *c) { -#ifdef __cplusplus - return reinterpret_cast(c)[1]; -#else - _npy_clongdouble_to_arr tmp; - tmp.comp = *c; - return tmp.arr[1]; -#endif -} - -static inline void NPY_CLONGDOUBLE_SET_REAL(npy_clongdouble *c, longdouble_t real) { -#ifdef __cplusplus - longdouble_t *tmp = reinterpret_cast(c); - tmp[0] = real; -#else - _npy_clongdouble_to_arr tmp; - tmp.comp = *c; - tmp.arr[0] = real; - *c = tmp.comp; -#endif -} - -static inline void NPY_CLONGDOUBLE_SET_IMAG(npy_clongdouble *c, longdouble_t imag) { -#ifdef __cplusplus - longdouble_t *tmp = reinterpret_cast(c); - tmp[1] = imag; -#else - _npy_clongdouble_to_arr tmp; - tmp.comp = *c; - tmp.arr[1] = imag; - *c = tmp.comp; -#endif -} - /* * numarray-style bit-width typedefs */ diff --git a/numpy/core/include/numpy/npy_math.h b/numpy/core/include/numpy/npy_math.h index 410683d215c1..b8af1e6c883c 100644 --- a/numpy/core/include/numpy/npy_math.h +++ b/numpy/core/include/numpy/npy_math.h @@ -356,6 +356,168 @@ NPY_INPLACE npy_longdouble npy_heavisidel(npy_longdouble x, npy_longdouble h0); /* * Complex declarations */ +#if !defined(__cplusplus) && defined(_MSC_VER) && !defined(__INTEL_COMPILER) +#define NPY_CDOUBLE_INIT(real, imag) (_Cbuild((double) (real), (double) (imag))) +#define NPY_CFLOAT_INIT(real, imag) (_FCbuild((float) (real), (float) (imag))) +#define NPY_CLONGDOUBLE_INIT(real, imag) (_LCbuild((longdouble_t) (real), (longdouble_t) (imag))) +#elif defined(__cplusplus) /* && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ +#define NPY_CDOUBLE_INIT(real, imag) (std::complex((double) (real), (double) (imag))) +#define NPY_CFLOAT_INIT(real, imag) (std::complex((float) (real), (float) (imag))) +#define NPY_CLONGDOUBLE_INIT(real, imag) (std::complex((longdouble_t) (real), (longdouble_t) (imag))) +#else /* !defined(__cplusplus) && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ +#define NPY_CDOUBLE_INIT(real, imag) ((double) (real) + _Complex_I * (double) (imag)) +#define NPY_CFLOAT_INIT(real, imag) ((float) (real) + _Complex_I * (float) (imag)) +#define NPY_CLONGDOUBLE_INIT(real, imag) ((longdouble_t) (real) + _Complex_I * (longdouble_t) (imag)) +#endif + +#ifndef __cplusplus +typedef union { + double arr[2]; + npy_cdouble comp; +} _npy_cdouble_to_arr; + +typedef union { + float arr[2]; + npy_cfloat comp; +} _npy_cfloat_to_arr; + +typedef union { + longdouble_t arr[2]; + npy_clongdouble comp; +} _npy_clongdouble_to_arr; +#endif + +static inline double NPY_CDOUBLE_GET_REAL(const npy_cdouble *c) { +#ifdef __cplusplus + return reinterpret_cast(c)[0]; +#else + _npy_cdouble_to_arr tmp; + tmp.comp = *c; + return tmp.arr[0]; +#endif +} + +static inline double NPY_CDOUBLE_GET_IMAG(const npy_cdouble *c) { +#ifdef __cplusplus + return reinterpret_cast(c)[1]; +#else + _npy_cdouble_to_arr tmp; + tmp.comp = *c; + return tmp.arr[1]; +#endif +} + +static inline void NPY_CDOUBLE_SET_REAL(npy_cdouble *c, double real) { +#ifdef __cplusplus + double *tmp = reinterpret_cast(c); + tmp[0] = real; +#else + _npy_cdouble_to_arr tmp; + tmp.comp = *c; + tmp.arr[0] = real; + *c = tmp.comp; +#endif +} + +static inline void NPY_CDOUBLE_SET_IMAG(npy_cdouble *c, double imag) { +#ifdef __cplusplus + double *tmp = reinterpret_cast(c); + tmp[1] = imag; +#else + _npy_cdouble_to_arr tmp; + tmp.comp = *c; + tmp.arr[1] = imag; + *c = tmp.comp; +#endif +} + +static inline float NPY_CFLOAT_GET_REAL(const npy_cfloat *c) { +#ifdef __cplusplus + return reinterpret_cast(c)[0]; +#else + _npy_cfloat_to_arr tmp; + tmp.comp = *c; + return tmp.arr[0]; +#endif +} + +static inline float NPY_CFLOAT_GET_IMAG(const npy_cfloat *c) { +#ifdef __cplusplus + return reinterpret_cast(c)[1]; +#else + _npy_cfloat_to_arr tmp; + tmp.comp = *c; + return tmp.arr[1]; +#endif +} + +static inline void NPY_CFLOAT_SET_REAL(npy_cfloat *c, float real) { +#ifdef __cplusplus + float *tmp = reinterpret_cast(c); + tmp[0] = real; +#else + _npy_cfloat_to_arr tmp; + tmp.comp = *c; + tmp.arr[0] = real; + *c = tmp.comp; +#endif +} + +static inline void NPY_CFLOAT_SET_IMAG(npy_cfloat *c, float imag) { +#ifdef __cplusplus + float *tmp = reinterpret_cast(c); + tmp[1] = imag; +#else + _npy_cfloat_to_arr tmp; + tmp.comp = *c; + tmp.arr[1] = imag; + *c = tmp.comp; +#endif +} + +static inline longdouble_t NPY_CLONGDOUBLE_GET_REAL(const npy_clongdouble *c) { +#ifdef __cplusplus + return reinterpret_cast(c)[0]; +#else + _npy_clongdouble_to_arr tmp; + tmp.comp = *c; + return tmp.arr[0]; +#endif +} + +static inline longdouble_t NPY_CLONGDOUBLE_GET_IMAG(const npy_clongdouble *c) { +#ifdef __cplusplus + return reinterpret_cast(c)[1]; +#else + _npy_clongdouble_to_arr tmp; + tmp.comp = *c; + return tmp.arr[1]; +#endif +} + +static inline void NPY_CLONGDOUBLE_SET_REAL(npy_clongdouble *c, longdouble_t real) { +#ifdef __cplusplus + longdouble_t *tmp = reinterpret_cast(c); + tmp[0] = real; +#else + _npy_clongdouble_to_arr tmp; + tmp.comp = *c; + tmp.arr[0] = real; + *c = tmp.comp; +#endif +} + +static inline void NPY_CLONGDOUBLE_SET_IMAG(npy_clongdouble *c, longdouble_t imag) { +#ifdef __cplusplus + longdouble_t *tmp = reinterpret_cast(c); + tmp[1] = imag; +#else + _npy_clongdouble_to_arr tmp; + tmp.comp = *c; + tmp.arr[1] = imag; + *c = tmp.comp; +#endif +} static inline npy_cdouble npy_cpack(double x, double y) { diff --git a/numpy/core/src/common/cblasfuncs.c b/numpy/core/src/common/cblasfuncs.c index 1bce66ef921f..a6c550125839 100644 --- a/numpy/core/src/common/cblasfuncs.c +++ b/numpy/core/src/common/cblasfuncs.c @@ -9,6 +9,7 @@ #include #include "numpy/arrayobject.h" +#include "numpy/npy_math.h" #include "npy_cblas.h" #include "arraytypes.h" #include "common.h" diff --git a/numpy/core/src/multiarray/textreading/conversions.c b/numpy/core/src/multiarray/textreading/conversions.c index 0142a7e3480d..358695481772 100644 --- a/numpy/core/src/multiarray/textreading/conversions.c +++ b/numpy/core/src/multiarray/textreading/conversions.c @@ -9,6 +9,7 @@ #define _MULTIARRAYMODULE #include "lowlevel_strided_loops.h" +#include "numpy/npy_math.h" #include "conversions.h" #include "str_to_int.h" diff --git a/numpy/core/src/npysort/npysort_common.h b/numpy/core/src/npysort/npysort_common.h index a79fefe3029e..e56d08bc11f9 100644 --- a/numpy/core/src/npysort/npysort_common.h +++ b/numpy/core/src/npysort/npysort_common.h @@ -3,6 +3,7 @@ #include #include +#include #ifdef __cplusplus extern "C" { diff --git a/numpy/core/src/umath/scalarmath.c.src b/numpy/core/src/umath/scalarmath.c.src index 6882b30046ab..d8bd895d94ff 100644 --- a/numpy/core/src/umath/scalarmath.c.src +++ b/numpy/core/src/umath/scalarmath.c.src @@ -16,6 +16,7 @@ #include "numpy/arrayobject.h" #include "numpy/ufuncobject.h" #include "numpy/arrayscalars.h" +#include "numpy/npy_math.h" #include "npy_import.h" #include "npy_pycompat.h" diff --git a/numpy/f2py/cfuncs.py b/numpy/f2py/cfuncs.py index 72d492b487d3..45290307c8a9 100644 --- a/numpy/f2py/cfuncs.py +++ b/numpy/f2py/cfuncs.py @@ -53,6 +53,7 @@ includes['arrayobject.h'] = '''#define PY_ARRAY_UNIQUE_SYMBOL PyArray_API #include "arrayobject.h"''' +includes['npy_math.h'] = '#include "numpy/npy_math.h"' includes['arrayobject.h'] = '#include "fortranobject.h"' includes['stdarg.h'] = '#include ' @@ -1096,7 +1097,7 @@ needs['complex_long_double_from_pyobj'] = ['complex_long_double', 'long_double', - 'complex_double_from_pyobj'] + 'complex_double_from_pyobj', 'npy_math.h'] cfuncs['complex_long_double_from_pyobj'] = """\ static int complex_long_double_from_pyobj(complex_long_double* v, PyObject *obj, const char *errmess) @@ -1123,7 +1124,7 @@ """ -needs['complex_double_from_pyobj'] = ['complex_double'] +needs['complex_double_from_pyobj'] = ['complex_double', 'npy_math.h'] cfuncs['complex_double_from_pyobj'] = """\ static int complex_double_from_pyobj(complex_double* v, PyObject *obj, const char *errmess) { From 7377f24eca0dccda40eef59600509f6ba2d8196b Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 14 Jul 2023 13:29:30 +0200 Subject: [PATCH 28/40] Remove necessity for INIT macro [wheel build] --- numpy/core/include/numpy/npy_math.h | 61 +++++++------------ numpy/core/src/multiarray/arraytypes.c.src | 13 ++-- numpy/core/src/multiarray/compiled_base.c | 4 +- .../src/multiarray/textreading/conversions.c | 4 +- numpy/core/src/umath/funcs.inc.src | 2 +- numpy/core/src/umath/loops.c.src | 4 +- numpy/core/src/umath/matmul.c.src | 3 +- numpy/core/src/umath/scalarmath.c.src | 18 ------ 8 files changed, 35 insertions(+), 74 deletions(-) diff --git a/numpy/core/include/numpy/npy_math.h b/numpy/core/include/numpy/npy_math.h index b8af1e6c883c..276095db7631 100644 --- a/numpy/core/include/numpy/npy_math.h +++ b/numpy/core/include/numpy/npy_math.h @@ -356,34 +356,21 @@ NPY_INPLACE npy_longdouble npy_heavisidel(npy_longdouble x, npy_longdouble h0); /* * Complex declarations */ -#if !defined(__cplusplus) && defined(_MSC_VER) && !defined(__INTEL_COMPILER) -#define NPY_CDOUBLE_INIT(real, imag) (_Cbuild((double) (real), (double) (imag))) -#define NPY_CFLOAT_INIT(real, imag) (_FCbuild((float) (real), (float) (imag))) -#define NPY_CLONGDOUBLE_INIT(real, imag) (_LCbuild((longdouble_t) (real), (longdouble_t) (imag))) -#elif defined(__cplusplus) /* && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ -#define NPY_CDOUBLE_INIT(real, imag) (std::complex((double) (real), (double) (imag))) -#define NPY_CFLOAT_INIT(real, imag) (std::complex((float) (real), (float) (imag))) -#define NPY_CLONGDOUBLE_INIT(real, imag) (std::complex((longdouble_t) (real), (longdouble_t) (imag))) -#else /* !defined(__cplusplus) && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ -#define NPY_CDOUBLE_INIT(real, imag) ((double) (real) + _Complex_I * (double) (imag)) -#define NPY_CFLOAT_INIT(real, imag) ((float) (real) + _Complex_I * (float) (imag)) -#define NPY_CLONGDOUBLE_INIT(real, imag) ((longdouble_t) (real) + _Complex_I * (longdouble_t) (imag)) -#endif #ifndef __cplusplus typedef union { - double arr[2]; - npy_cdouble comp; + double *arr; + const npy_cdouble *comp; } _npy_cdouble_to_arr; typedef union { - float arr[2]; - npy_cfloat comp; + float *arr; + const npy_cfloat *comp; } _npy_cfloat_to_arr; typedef union { - longdouble_t arr[2]; - npy_clongdouble comp; + longdouble_t *arr; + const npy_clongdouble *comp; } _npy_clongdouble_to_arr; #endif @@ -392,7 +379,7 @@ static inline double NPY_CDOUBLE_GET_REAL(const npy_cdouble *c) { return reinterpret_cast(c)[0]; #else _npy_cdouble_to_arr tmp; - tmp.comp = *c; + tmp.comp = c; return tmp.arr[0]; #endif } @@ -402,7 +389,7 @@ static inline double NPY_CDOUBLE_GET_IMAG(const npy_cdouble *c) { return reinterpret_cast(c)[1]; #else _npy_cdouble_to_arr tmp; - tmp.comp = *c; + tmp.comp = c; return tmp.arr[1]; #endif } @@ -413,9 +400,8 @@ static inline void NPY_CDOUBLE_SET_REAL(npy_cdouble *c, double real) { tmp[0] = real; #else _npy_cdouble_to_arr tmp; - tmp.comp = *c; + tmp.comp = c; tmp.arr[0] = real; - *c = tmp.comp; #endif } @@ -425,9 +411,8 @@ static inline void NPY_CDOUBLE_SET_IMAG(npy_cdouble *c, double imag) { tmp[1] = imag; #else _npy_cdouble_to_arr tmp; - tmp.comp = *c; + tmp.comp = c; tmp.arr[1] = imag; - *c = tmp.comp; #endif } @@ -436,7 +421,7 @@ static inline float NPY_CFLOAT_GET_REAL(const npy_cfloat *c) { return reinterpret_cast(c)[0]; #else _npy_cfloat_to_arr tmp; - tmp.comp = *c; + tmp.comp = c; return tmp.arr[0]; #endif } @@ -446,7 +431,7 @@ static inline float NPY_CFLOAT_GET_IMAG(const npy_cfloat *c) { return reinterpret_cast(c)[1]; #else _npy_cfloat_to_arr tmp; - tmp.comp = *c; + tmp.comp = c; return tmp.arr[1]; #endif } @@ -457,9 +442,8 @@ static inline void NPY_CFLOAT_SET_REAL(npy_cfloat *c, float real) { tmp[0] = real; #else _npy_cfloat_to_arr tmp; - tmp.comp = *c; + tmp.comp = c; tmp.arr[0] = real; - *c = tmp.comp; #endif } @@ -469,9 +453,8 @@ static inline void NPY_CFLOAT_SET_IMAG(npy_cfloat *c, float imag) { tmp[1] = imag; #else _npy_cfloat_to_arr tmp; - tmp.comp = *c; + tmp.comp = c; tmp.arr[1] = imag; - *c = tmp.comp; #endif } @@ -480,7 +463,7 @@ static inline longdouble_t NPY_CLONGDOUBLE_GET_REAL(const npy_clongdouble *c) { return reinterpret_cast(c)[0]; #else _npy_clongdouble_to_arr tmp; - tmp.comp = *c; + tmp.comp = c; return tmp.arr[0]; #endif } @@ -490,7 +473,7 @@ static inline longdouble_t NPY_CLONGDOUBLE_GET_IMAG(const npy_clongdouble *c) { return reinterpret_cast(c)[1]; #else _npy_clongdouble_to_arr tmp; - tmp.comp = *c; + tmp.comp = c; return tmp.arr[1]; #endif } @@ -501,9 +484,8 @@ static inline void NPY_CLONGDOUBLE_SET_REAL(npy_clongdouble *c, longdouble_t rea tmp[0] = real; #else _npy_clongdouble_to_arr tmp; - tmp.comp = *c; + tmp.comp = c; tmp.arr[0] = real; - *c = tmp.comp; #endif } @@ -513,15 +495,14 @@ static inline void NPY_CLONGDOUBLE_SET_IMAG(npy_clongdouble *c, longdouble_t ima tmp[1] = imag; #else _npy_clongdouble_to_arr tmp; - tmp.comp = *c; + tmp.comp = c; tmp.arr[1] = imag; - *c = tmp.comp; #endif } static inline npy_cdouble npy_cpack(double x, double y) { - npy_cdouble z = NPY_CDOUBLE_INIT(0.0, 0.0); + npy_cdouble z; NPY_CDOUBLE_SET_REAL(&z, x); NPY_CDOUBLE_SET_IMAG(&z, y); return z; @@ -529,7 +510,7 @@ static inline npy_cdouble npy_cpack(double x, double y) static inline npy_cfloat npy_cpackf(float x, float y) { - npy_cfloat z = NPY_CFLOAT_INIT(0.0f, 0.0f); + npy_cfloat z; NPY_CFLOAT_SET_REAL(&z, x); NPY_CFLOAT_SET_IMAG(&z, y); return z; @@ -537,7 +518,7 @@ static inline npy_cfloat npy_cpackf(float x, float y) static inline npy_clongdouble npy_cpackl(npy_longdouble x, npy_longdouble y) { - npy_clongdouble z = NPY_CLONGDOUBLE_INIT(0.0l, 0.0l); + npy_clongdouble z; NPY_CLONGDOUBLE_SET_REAL(&z, x); NPY_CLONGDOUBLE_SET_IMAG(&z, y); return z; diff --git a/numpy/core/src/multiarray/arraytypes.c.src b/numpy/core/src/multiarray/arraytypes.c.src index c85d0c1c332d..0a64155db8d6 100644 --- a/numpy/core/src/multiarray/arraytypes.c.src +++ b/numpy/core/src/multiarray/arraytypes.c.src @@ -441,14 +441,13 @@ static PyObject * * #type = npy_cfloat, npy_cdouble, npy_clongdouble# * #ftype = npy_float, npy_double, npy_longdouble# * #kind = CFloat, CDouble, CLongDouble# - * #c = f, , l# */ NPY_NO_EXPORT int @NAME@_setitem(PyObject *op, void *ov, void *vap) { PyArrayObject *ap = vap; Py_complex oop; - @type@ temp = NPY_@NAME@_INIT(0.0@c@, 0.0@c@); + @type@ temp; if (PyArray_IsZeroDim(op)) { return convert_to_scalar_and_retry(op, ov, vap, @NAME@_setitem); @@ -1934,7 +1933,6 @@ BOOL_scan(FILE *fp, npy_bool *ip, void *NPY_UNUSED(ignore), /**begin repeat * #fname = CFLOAT, CDOUBLE# * #type = npy_cfloat, npy_cdouble# - * #c = f, # */ static int @fname@_scan(FILE *fp, @type@ *ip, void *NPY_UNUSED(ignore), @@ -1944,7 +1942,7 @@ static int int ret_real, ret_imag; ret_real = NumPyOS_ascii_ftolf(fp, &result); - @type@ output = NPY_@fname@_INIT(0.0@c@, 0.0@c@); + @type@ output; // Peek next character char next = getc(fp); if ((next == '+') || (next == '-')) { @@ -2078,7 +2076,6 @@ BOOL_fromstr(char *str, void *ip, char **endptr, /**begin repeat * #fname = CFLOAT, CDOUBLE# * #type = npy_cfloat, npy_cdouble# - * #c = f, # */ static int @fname@_fromstr(char *str, void *ip, char **endptr, @@ -2087,7 +2084,7 @@ static int double result; result = NumPyOS_ascii_strtod(str, endptr); - @type@ output = NPY_@fname@_INIT(0.0@c@, 0.0@c@); + @type@ output; if (endptr && ((*endptr[0] == '+') || (*endptr[0] == '-'))) { // Imaginary component specified @@ -3983,8 +3980,8 @@ static int @NAME@_fill(@type@ *buffer, npy_intp length, void *NPY_UNUSED(ignore)) { npy_intp i; - @type@ start = NPY_@NAME@_INIT(0.0, 0.0); - @type@ delta = NPY_@NAME@_INIT(0.0, 0.0); + @type@ start; + @type@ delta; NPY_@NAME@_SET_REAL(&start, NPY_@NAME@_GET_REAL(buffer)); NPY_@NAME@_SET_IMAG(&start, NPY_@NAME@_GET_IMAG(buffer)); diff --git a/numpy/core/src/multiarray/compiled_base.c b/numpy/core/src/multiarray/compiled_base.c index a41264deec81..656184fd522c 100644 --- a/numpy/core/src/multiarray/compiled_base.c +++ b/numpy/core/src/multiarray/compiled_base.c @@ -675,7 +675,7 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t const npy_double *dx, *dz; const npy_cdouble *dy; - npy_cdouble lval = NPY_CDOUBLE_INIT(0.0, 0.0), rval = NPY_CDOUBLE_INIT(0.0, 0.0); + npy_cdouble lval, rval; npy_cdouble *dres, *slopes = NULL; NPY_BEGIN_THREADS_DEF; @@ -817,7 +817,7 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t dres[i] = dy[j]; } else { - npy_cdouble slope = NPY_CDOUBLE_INIT(0.0, 0.0); + npy_cdouble slope; if (slopes != NULL) { slope = slopes[j]; } diff --git a/numpy/core/src/multiarray/textreading/conversions.c b/numpy/core/src/multiarray/textreading/conversions.c index 358695481772..5129034ee920 100644 --- a/numpy/core/src/multiarray/textreading/conversions.c +++ b/numpy/core/src/multiarray/textreading/conversions.c @@ -243,7 +243,7 @@ npy_to_cfloat(PyArray_Descr *descr, if (!success) { return -1; } - npy_complex64 val = NPY_CFLOAT_INIT(0.0f, 0.0f); + npy_complex64 val; NPY_CFLOAT_SET_REAL(&val, (float) real); NPY_CFLOAT_SET_IMAG(&val, (float) imag); memcpy(dataptr, &val, sizeof(npy_complex64)); @@ -269,7 +269,7 @@ npy_to_cdouble(PyArray_Descr *descr, if (!success) { return -1; } - npy_complex128 val = NPY_CDOUBLE_INIT(0.0, 0.0); + npy_complex128 val; NPY_CDOUBLE_SET_REAL(&val, real); NPY_CDOUBLE_SET_IMAG(&val, imag); memcpy(dataptr, &val, sizeof(npy_complex128)); diff --git a/numpy/core/src/umath/funcs.inc.src b/numpy/core/src/umath/funcs.inc.src index bfcc0afe53e0..a5887da3b27a 100644 --- a/numpy/core/src/umath/funcs.inc.src +++ b/numpy/core/src/umath/funcs.inc.src @@ -345,7 +345,7 @@ nc_exp@c@(@ctype@ *x, @ctype@ *r) static void nc_exp2@c@(@ctype@ *x, @ctype@ *r) { - @ctype@ a = NPY_@NAME@_INIT(0.0@c@, 0.0@c@); + @ctype@ a; NPY_@NAME@_SET_REAL(&a, NPY_@NAME@_GET_REAL(x)*NPY_LOGE2@c@); NPY_@NAME@_SET_IMAG(&a, NPY_@NAME@_GET_IMAG(x)*NPY_LOGE2@c@); nc_exp@c@(&a, r); diff --git a/numpy/core/src/umath/loops.c.src b/numpy/core/src/umath/loops.c.src index 8324e1818a91..85fe1ac27716 100644 --- a/numpy/core/src/umath/loops.c.src +++ b/numpy/core/src/umath/loops.c.src @@ -157,7 +157,7 @@ PyUFunc_F_F_As_D_D(char **args, npy_intp const *dimensions, npy_intp const *step typedef void func_type(npy_cdouble *, npy_cdouble *); func_type *f = (func_type *)func; UNARY_LOOP { - npy_cdouble tmp = NPY_CDOUBLE_INIT(0.0, 0.0), out = NPY_CDOUBLE_INIT(0.0, 0.0); + npy_cdouble tmp, out; NPY_CDOUBLE_SET_REAL(&tmp, (double)((float *)ip1)[0]); NPY_CDOUBLE_SET_IMAG(&tmp, (double)((float *)ip1)[1]); f(&tmp, &out); @@ -173,7 +173,7 @@ PyUFunc_FF_F_As_DD_D(char **args, npy_intp const *dimensions, npy_intp const *st typedef void func_type(npy_cdouble *, npy_cdouble *, npy_cdouble *); func_type *f = (func_type *)func; BINARY_LOOP { - npy_cdouble tmp1 = NPY_CDOUBLE_INIT(0.0, 0.0), tmp2 = NPY_CDOUBLE_INIT(0.0, 0.0), out = NPY_CDOUBLE_INIT(0.0, 0.0); + npy_cdouble tmp1, tmp2, out; NPY_CDOUBLE_SET_REAL(&tmp1, (double)((float *)ip1)[0]); NPY_CDOUBLE_SET_IMAG(&tmp1, (double)((float *)ip1)[1]); NPY_CDOUBLE_SET_REAL(&tmp2, (double)((float *)ip2)[0]); diff --git a/numpy/core/src/umath/matmul.c.src b/numpy/core/src/umath/matmul.c.src index 515a0098c635..76dd01b14a17 100644 --- a/numpy/core/src/umath/matmul.c.src +++ b/numpy/core/src/umath/matmul.c.src @@ -242,7 +242,8 @@ NPY_NO_EXPORT void for (m = 0; m < dm; m++) { for (p = 0; p < dp; p++) { #if @IS_COMPLEX@ == 1 - *(@typ@ *)op = NPY_@TYPE@_INIT(0.0, 0.0); + NPY_@TYPE@_SET_REAL((@typ@ *)op, 0.0); + NPY_@TYPE@_SET_IMAG((@typ@ *)op, 0.0); #elif @IS_HALF@ float sum = 0; #else diff --git a/numpy/core/src/umath/scalarmath.c.src b/numpy/core/src/umath/scalarmath.c.src index d8bd895d94ff..30e906cb7680 100644 --- a/numpy/core/src/umath/scalarmath.c.src +++ b/numpy/core/src/umath/scalarmath.c.src @@ -1626,31 +1626,13 @@ static PyObject * * Byte, UByte, Short, UShort, Int, UInt, * Long, ULong, LongLong, ULongLong# * - * #ONAME = (BYTE, UBYTE, SHORT, USHORT, INT, UINT, - * LONG, ULONG, LONGLONG, ULONGLONG, - * HALF, FLOAT, DOUBLE, LONGDOUBLE, - * CFLOAT, CDOUBLE, CLONGDOUBLE)*2, - * BYTE, UBYTE, SHORT, USHORT, INT, UINT, - * LONG, ULONG, LONGLONG, ULONGLONG, - * HALF, FLOAT, DOUBLE, LONGDOUBLE, - * FLOAT, DOUBLE, LONGDOUBLE, - * - * BYTE, UBYTE, SHORT, USHORT, INT, UINT, - * LONG, ULONG, LONGLONG, ULONGLONG# - * - * #IS_COMPLEX = 0*14, 1*3, 0*14, 1*3, 0*27# - * * #oper = negative*17, positive*17, absolute*17, invert*10# */ static PyObject * @name@_@oper@(PyObject *a) { @type@ val; -#if @IS_COMPLEX@ == 1 - @otype@ out = NPY_@ONAME@_INIT(0.0, 0.0); -#else @otype@ out; -#endif PyObject *ret; From 045a8cdba9a3ad4021afbdab77ad23665f27b67f Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 14 Jul 2023 13:49:08 +0200 Subject: [PATCH 29/40] Fix Windows-CL workflow; update to latest cython 0.29.x --- .github/workflows/windows_clangcl.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/windows_clangcl.yml b/.github/workflows/windows_clangcl.yml index 2b270d99eac0..eaec6cdaebd3 100644 --- a/.github/workflows/windows_clangcl.yml +++ b/.github/workflows/windows_clangcl.yml @@ -35,6 +35,8 @@ jobs: - name: Install dependencies run: | pip install -r build_requirements.txt + pip uninstall -y cython + pip install git+https://github.com/cython/cython.git@436f8a32ea3a1b0411695db1b974c60434042b5b - name: openblas-libs run: | # Download and install pre-built OpenBLAS library From ddcdf8631936e76da131b9aceb3e5d5639a1c023 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Mon, 17 Jul 2023 12:16:01 +0200 Subject: [PATCH 30/40] Necessary changes to only use C99 complex types (not std::complex) --- numpy/core/include/numpy/ndarraytypes.h | 18 +--- numpy/core/include/numpy/npy_common.h | 15 ++- numpy/core/include/numpy/npy_math.h | 56 ----------- numpy/core/src/npymath/npy_math_complex.c.src | 4 +- numpy/core/src/umath/clip.cpp | 82 +++++++++------- numpy/core/src/umath/matmul.c.src | 7 +- numpy/linalg/umath_linalg.cpp | 94 ++++++++++++++----- 7 files changed, 126 insertions(+), 150 deletions(-) diff --git a/numpy/core/include/numpy/ndarraytypes.h b/numpy/core/include/numpy/ndarraytypes.h index a95c7cf2f4a1..f7aa9e6c3601 100644 --- a/numpy/core/include/numpy/ndarraytypes.h +++ b/numpy/core/include/numpy/ndarraytypes.h @@ -2,6 +2,7 @@ #define NUMPY_CORE_INCLUDE_NUMPY_NDARRAYTYPES_H_ #include "npy_common.h" +#include "npy_math.h" #include "npy_endian.h" #include "npy_cpu.h" #include "utils.h" @@ -963,22 +964,6 @@ typedef int (PyArray_FinalizeFunc)(PyArrayObject *, PyObject *); #define PyArray_MAX(a,b) (((a)>(b))?(a):(b)) #define PyArray_MIN(a,b) (((a)<(b))?(a):(b)) -#ifdef __cplusplus -#define PyArray_CLT(p,q, type) (p).real() == (q).real() \ - ? (p).imag() < (q).imag() \ - : (p).real() < (q).real() -#define PyArray_CGT(p,q, type) (p).real() == (q).real() \ - ? (p).imag() > (q).imag() \ - : (p).real() > (q).real() -#define PyArray_CLE(p,q, type) (p).real() == (q).real() \ - ? (p).imag() <= (q).imag() \ - : (p).real() <= (q).real() -#define PyArray_CGE(p,q, type) (p).real() == (q).real() \ - ? (p).imag() >= (q).imag() \ - : (p).real() >= (q).real() -#define PyArray_CEQ(p,q, type) (p) == (q) -#define PyArray_CNE(p,q, type) (p) != (q) -#else #define PyArray_CLT(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ ? NPY_##type##_GET_IMAG(&(p)) < NPY_##type##_GET_IMAG(&(q)) \ : NPY_##type##_GET_REAL(&(p)) < NPY_##type##_GET_REAL(&(q)) @@ -993,7 +978,6 @@ typedef int (PyArray_FinalizeFunc)(PyArrayObject *, PyObject *); : NPY_##type##_GET_REAL(&(p)) >= NPY_##type##_GET_REAL(&(q)) #define PyArray_CEQ(p,q, type) (p) == (q) #define PyArray_CNE(p,q, type) (p) != (q) -#endif /* * C API: consists of Macros and functions. The MACROS are defined diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index b064bae233a1..5c81e7f698e4 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -380,20 +380,19 @@ typedef Py_hash_t npy_hash_t; #endif -#if !defined(__cplusplus) && defined(_MSC_VER) && !defined(__INTEL_COMPILER) +#if defined(_MSC_VER) && !defined(__INTEL_COMPILER) #include typedef _Dcomplex npy_cdouble; typedef _Fcomplex npy_cfloat; typedef _Lcomplex npy_clongdouble; -#elif defined(__cplusplus) /* && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ -extern "C++" { -#include -} -typedef std::complex npy_cdouble; -typedef std::complex npy_cfloat; -typedef std::complex npy_clongdouble; #else /* !defined(__cplusplus) && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ +#ifdef __cplusplus +extern "C++" { +#endif #include +#ifdef __cplusplus +} +#endif #undef complex typedef double _Complex npy_cdouble; typedef float _Complex npy_cfloat; diff --git a/numpy/core/include/numpy/npy_math.h b/numpy/core/include/numpy/npy_math.h index 276095db7631..766bba3f6e5b 100644 --- a/numpy/core/include/numpy/npy_math.h +++ b/numpy/core/include/numpy/npy_math.h @@ -357,7 +357,6 @@ NPY_INPLACE npy_longdouble npy_heavisidel(npy_longdouble x, npy_longdouble h0); * Complex declarations */ -#ifndef __cplusplus typedef union { double *arr; const npy_cdouble *comp; @@ -372,132 +371,77 @@ typedef union { longdouble_t *arr; const npy_clongdouble *comp; } _npy_clongdouble_to_arr; -#endif static inline double NPY_CDOUBLE_GET_REAL(const npy_cdouble *c) { -#ifdef __cplusplus - return reinterpret_cast(c)[0]; -#else _npy_cdouble_to_arr tmp; tmp.comp = c; return tmp.arr[0]; -#endif } static inline double NPY_CDOUBLE_GET_IMAG(const npy_cdouble *c) { -#ifdef __cplusplus - return reinterpret_cast(c)[1]; -#else _npy_cdouble_to_arr tmp; tmp.comp = c; return tmp.arr[1]; -#endif } static inline void NPY_CDOUBLE_SET_REAL(npy_cdouble *c, double real) { -#ifdef __cplusplus - double *tmp = reinterpret_cast(c); - tmp[0] = real; -#else _npy_cdouble_to_arr tmp; tmp.comp = c; tmp.arr[0] = real; -#endif } static inline void NPY_CDOUBLE_SET_IMAG(npy_cdouble *c, double imag) { -#ifdef __cplusplus - double *tmp = reinterpret_cast(c); - tmp[1] = imag; -#else _npy_cdouble_to_arr tmp; tmp.comp = c; tmp.arr[1] = imag; -#endif } static inline float NPY_CFLOAT_GET_REAL(const npy_cfloat *c) { -#ifdef __cplusplus - return reinterpret_cast(c)[0]; -#else _npy_cfloat_to_arr tmp; tmp.comp = c; return tmp.arr[0]; -#endif } static inline float NPY_CFLOAT_GET_IMAG(const npy_cfloat *c) { -#ifdef __cplusplus - return reinterpret_cast(c)[1]; -#else _npy_cfloat_to_arr tmp; tmp.comp = c; return tmp.arr[1]; -#endif } static inline void NPY_CFLOAT_SET_REAL(npy_cfloat *c, float real) { -#ifdef __cplusplus - float *tmp = reinterpret_cast(c); - tmp[0] = real; -#else _npy_cfloat_to_arr tmp; tmp.comp = c; tmp.arr[0] = real; -#endif } static inline void NPY_CFLOAT_SET_IMAG(npy_cfloat *c, float imag) { -#ifdef __cplusplus - float *tmp = reinterpret_cast(c); - tmp[1] = imag; -#else _npy_cfloat_to_arr tmp; tmp.comp = c; tmp.arr[1] = imag; -#endif } static inline longdouble_t NPY_CLONGDOUBLE_GET_REAL(const npy_clongdouble *c) { -#ifdef __cplusplus - return reinterpret_cast(c)[0]; -#else _npy_clongdouble_to_arr tmp; tmp.comp = c; return tmp.arr[0]; -#endif } static inline longdouble_t NPY_CLONGDOUBLE_GET_IMAG(const npy_clongdouble *c) { -#ifdef __cplusplus - return reinterpret_cast(c)[1]; -#else _npy_clongdouble_to_arr tmp; tmp.comp = c; return tmp.arr[1]; -#endif } static inline void NPY_CLONGDOUBLE_SET_REAL(npy_clongdouble *c, longdouble_t real) { -#ifdef __cplusplus - longdouble_t *tmp = reinterpret_cast(c); - tmp[0] = real; -#else _npy_clongdouble_to_arr tmp; tmp.comp = c; tmp.arr[0] = real; -#endif } static inline void NPY_CLONGDOUBLE_SET_IMAG(npy_clongdouble *c, longdouble_t imag) { -#ifdef __cplusplus - longdouble_t *tmp = reinterpret_cast(c); - tmp[1] = imag; -#else _npy_clongdouble_to_arr tmp; tmp.comp = c; tmp.arr[1] = imag; -#endif } static inline npy_cdouble npy_cpack(double x, double y) diff --git a/numpy/core/src/npymath/npy_math_complex.c.src b/numpy/core/src/npymath/npy_math_complex.c.src index 9cb889d3aa1c..8190f0447742 100644 --- a/numpy/core/src/npymath/npy_math_complex.c.src +++ b/numpy/core/src/npymath/npy_math_complex.c.src @@ -65,10 +65,8 @@ static const volatile npy_float tiny = 3.9443045e-31f; /*========================================================== * Constants *=========================================================*/ -#if !defined(__cplusplus) && defined(_MSC_VER) && !defined(__INTEL_COMPILER) +#if defined(_MSC_VER) && !defined(__INTEL_COMPILER) static const @ctype@ c_1@c@ = {1.0@C@, 0.0@C@}; -#elif defined(__cplusplus) -static const @ctype@ c_1@c@ (1.0@C@, 0.0@C@); #else static const @ctype@ c_1@c@ = 1.0@C@; #endif diff --git a/numpy/core/src/umath/clip.cpp b/numpy/core/src/umath/clip.cpp index 5548c9f0ddd5..d90ae5c279e5 100644 --- a/numpy/core/src/umath/clip.cpp +++ b/numpy/core/src/umath/clip.cpp @@ -55,47 +55,57 @@ _NPY_MAX(T a, T b, npy::floating_point_tag const &) return npy_isnan(a) ? (a) : PyArray_MAX(a, b); } -template -T -_NPY_MIN(T a, T b, npy::complex_tag const &) +npy_cdouble +_NPY_MIN(npy_cdouble a, npy_cdouble b, npy::complex_tag const &) { - if (std::is_same::value) { - return npy_isnan(a.real()) || npy_isnan(a.imag()) || PyArray_CLT(a, b, CDOUBLE) - ? (a) - : (b); - } - else if (std::is_same::value) { - return npy_isnan(a.real()) || npy_isnan(a.imag()) || PyArray_CLT(a, b, CFLOAT) - ? (a) - : (b); - } - else { - return npy_isnan(a.real()) || npy_isnan(a.imag()) || PyArray_CLT(a, b, CLONGDOUBLE) - ? (a) - : (b); - } + return npy_isnan(NPY_CDOUBLE_GET_REAL(&a)) || npy_isnan(NPY_CDOUBLE_GET_IMAG(&a)) || PyArray_CLT(a, b, CDOUBLE) + ? (a) + : (b); } -template -T -_NPY_MAX(T a, T b, npy::complex_tag const &) +npy_cfloat +_NPY_MIN(npy_cfloat a, npy_cfloat b, npy::complex_tag const &) { - if (std::is_same::value) { - return npy_isnan(a.real()) || npy_isnan(a.imag()) || PyArray_CGT(a, b, CDOUBLE) - ? (a) - : (b); - } - else if (std::is_same::value) { - return npy_isnan(a.real()) || npy_isnan(a.imag()) || PyArray_CGT(a, b, CFLOAT) - ? (a) - : (b); - } - else { - return npy_isnan(a.real()) || npy_isnan(a.imag()) || PyArray_CGT(a, b, CLONGDOUBLE) - ? (a) - : (b); - } + return npy_isnan(NPY_CFLOAT_GET_REAL(&a)) || npy_isnan(NPY_CFLOAT_GET_IMAG(&a)) || PyArray_CLT(a, b, CFLOAT) + ? (a) + : (b); +} + +#if NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE +npy_clongdouble +_NPY_MIN(npy_clongdouble a, npy_clongdouble b, npy::complex_tag const &) +{ + return npy_isnan(NPY_CLONGDOUBLE_GET_REAL(&a)) || npy_isnan(NPY_CLONGDOUBLE_GET_IMAG(&a)) || PyArray_CLT(a, b, CLONGDOUBLE) + ? (a) + : (b); +} +#endif + +npy_cdouble +_NPY_MAX(npy_cdouble a, npy_cdouble b, npy::complex_tag const &) +{ + return npy_isnan(NPY_CDOUBLE_GET_REAL(&a)) || npy_isnan(NPY_CDOUBLE_GET_IMAG(&a)) || PyArray_CGT(a, b, CDOUBLE) + ? (a) + : (b); +} + +npy_cfloat +_NPY_MAX(npy_cfloat a, npy_cfloat b, npy::complex_tag const &) +{ + return npy_isnan(NPY_CFLOAT_GET_REAL(&a)) || npy_isnan(NPY_CFLOAT_GET_IMAG(&a)) || PyArray_CGT(a, b, CFLOAT) + ? (a) + : (b); +} + +#if NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE +npy_clongdouble +_NPY_MAX(npy_clongdouble a, npy_clongdouble b, npy::complex_tag const &) +{ + return npy_isnan(NPY_CLONGDOUBLE_GET_REAL(&a)) || npy_isnan(NPY_CLONGDOUBLE_GET_IMAG(&a)) || PyArray_CGT(a, b, CLONGDOUBLE) + ? (a) + : (b); } +#endif template T diff --git a/numpy/core/src/umath/matmul.c.src b/numpy/core/src/umath/matmul.c.src index 76dd01b14a17..e85d27202d2a 100644 --- a/numpy/core/src/umath/matmul.c.src +++ b/numpy/core/src/umath/matmul.c.src @@ -62,14 +62,9 @@ is_blasable2d(npy_intp byte_stride1, npy_intp byte_stride2, return NPY_FALSE; } -#if !defined(__cplusplus) && defined(_MSC_VER) && !defined(__INTEL_COMPILER) +#if defined(_MSC_VER) && !defined(__INTEL_COMPILER) static const npy_cdouble oneD = {1.0, 0.0}, zeroD = {0.0, 0.0}; static const npy_cfloat oneF = {1.0f, 0.0f}, zeroF = {0.0f, 0.0f}; -#elif defined(__cplusplus) -static const npy_cdouble oneD (1.0, 0.0); -static const npy_cdouble zeroD (0.0, 0.0); -static const npy_cfloat oneF (1.0f, 0.0f); -static const npy_cfloat zeroF (0.0f, 0.0f); #else static const npy_cdouble oneD = 1.0, zeroD = 0.0; static const npy_cfloat oneF = 1.0f, zeroF = 0.0f; diff --git a/numpy/linalg/umath_linalg.cpp b/numpy/linalg/umath_linalg.cpp index 42434d7120a7..ea125b79cf8a 100644 --- a/numpy/linalg/umath_linalg.cpp +++ b/numpy/linalg/umath_linalg.cpp @@ -11,6 +11,7 @@ #define NPY_NO_DEPRECATED_API NPY_API_VERSION #include "numpy/arrayobject.h" #include "numpy/ufuncobject.h" +#include "numpy/npy_math.h" #include "npy_pycompat.h" @@ -28,11 +29,6 @@ static const char* umath_linalg_version_string = "0.1.5"; -struct scalar_trait {}; -struct complex_trait {}; -template -using dispatch_scalar = typename std::conditional::value, scalar_trait, complex_trait>::type; - /* **************************************************************************** * Debugging support * @@ -469,6 +465,21 @@ constexpr double numeric_limits::minus_one; const double numeric_limits::ninf = -NPY_INFINITY; const double numeric_limits::nan = NPY_NAN; +#if defined(_MSC_VER) && !defined(__INTEL_COMPILER) +template<> +struct numeric_limits { +static constexpr npy_cfloat one = {1.0f, 0.0f}; +static constexpr npy_cfloat zero = {0.0f, 0.0f}; +static constexpr npy_cfloat minus_one = {-1.0f, 0.0f}; +static const npy_cfloat ninf; +static const npy_cfloat nan; +}; +constexpr npy_cfloat numeric_limits::one; +constexpr npy_cfloat numeric_limits::zero; +constexpr npy_cfloat numeric_limits::minus_one; +const npy_cfloat numeric_limits::ninf = {-NPY_INFINITYF, 0.0f}; +const npy_cfloat numeric_limits::nan = {NPY_NANF, NPY_NANF}; +#else template<> struct numeric_limits { static constexpr npy_cfloat one = 1.0f; @@ -480,8 +491,9 @@ static const npy_cfloat nan; constexpr npy_cfloat numeric_limits::one; constexpr npy_cfloat numeric_limits::zero; constexpr npy_cfloat numeric_limits::minus_one; -const npy_cfloat numeric_limits::ninf = {-NPY_INFINITYF, 0.0f}; -const npy_cfloat numeric_limits::nan = {NPY_NANF, NPY_NANF}; +const npy_cfloat numeric_limits::ninf = -NPY_INFINITYF; +const npy_cfloat numeric_limits::nan = NPY_NANF; +#endif template<> struct numeric_limits { @@ -497,6 +509,21 @@ constexpr f2c_complex numeric_limits::minus_one; const f2c_complex numeric_limits::ninf = {-NPY_INFINITYF, 0.0f}; const f2c_complex numeric_limits::nan = {NPY_NANF, NPY_NANF}; +#if defined(_MSC_VER) && !defined(__INTEL_COMPILER) +template<> +struct numeric_limits { +static constexpr npy_cdouble one = {1.0, 0.0}; +static constexpr npy_cdouble zero = {0.0, 0.0}; +static constexpr npy_cdouble minus_one = {-1.0, 0.0}; +static const npy_cdouble ninf; +static const npy_cdouble nan; +}; +constexpr npy_cdouble numeric_limits::one; +constexpr npy_cdouble numeric_limits::zero; +constexpr npy_cdouble numeric_limits::minus_one; +const npy_cdouble numeric_limits::ninf = {-NPY_INFINITY, 0.0}; +const npy_cdouble numeric_limits::nan = {NPY_NAN, NPY_NAN}; +#else template<> struct numeric_limits { static constexpr npy_cdouble one = 1.0; @@ -508,8 +535,9 @@ static const npy_cdouble nan; constexpr npy_cdouble numeric_limits::one; constexpr npy_cdouble numeric_limits::zero; constexpr npy_cdouble numeric_limits::minus_one; -const npy_cdouble numeric_limits::ninf = {-NPY_INFINITY, 0.0}; -const npy_cdouble numeric_limits::nan = {NPY_NAN, NPY_NAN}; +const npy_cdouble numeric_limits::ninf = -NPY_INFINITY; +const npy_cdouble numeric_limits::nan = NPY_NAN; +#endif template<> struct numeric_limits { @@ -840,6 +868,12 @@ template<> struct basetype { using type = fortran_doublereal; template using basetype_t = typename basetype::type; +struct scalar_trait {}; +struct complex_trait {}; +template +using dispatch_scalar = typename std::conditional) == sizeof(typ), scalar_trait, complex_trait>::type; + + /* rearranging of 2D matrices using blas */ template @@ -1046,10 +1080,26 @@ det_from_slogdet(typ sign, typ logdet) npy_float npyabs(npy_cfloat z) { return npy_cabsf(z);} npy_double npyabs(npy_cdouble z) { return npy_cabs(z);} -#define RE(COMPLEX) (COMPLEX).real() -#define IM(COMPLEX) (COMPLEX).imag() -#define SETRE(COMPLEX, VALUE) (COMPLEX).real(VALUE) -#define SETIM(COMPLEX, VALUE) (COMPLEX).imag(VALUE) +inline float RE(npy_cfloat *c) { return NPY_CFLOAT_GET_REAL(c); } +inline double RE(npy_cdouble *c) { return NPY_CDOUBLE_GET_REAL(c); } +#if NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE +inline longdouble_t RE(npy_clongdouble *c) { return NPY_CLONGDOUBLE_GET_REAL(c); } +#endif +inline float IM(npy_cfloat *c) { return NPY_CFLOAT_GET_IMAG(c); } +inline double IM(npy_cdouble *c) { return NPY_CDOUBLE_GET_IMAG(c); } +#if NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE +inline longdouble_t IM(npy_clongdouble *c) { return NPY_CLONGDOUBLE_GET_IMAG(c); } +#endif +inline void SETRE(npy_cfloat *c, float real) { NPY_CFLOAT_SET_REAL(c, real); } +inline void SETRE(npy_cdouble *c, double real) { NPY_CDOUBLE_SET_REAL(c, real); } +#if NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE +inline void SETRE(npy_clongdouble *c, double real) { NPY_CLONGDOUBLE_SET_REAL(c, real); } +#endif +inline void SETIM(npy_cfloat *c, float real) { NPY_CFLOAT_SET_IMAG(c, real); } +inline void SETIM(npy_cdouble *c, double real) { NPY_CDOUBLE_SET_IMAG(c, real); } +#if NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE +inline void SETIM(npy_clongdouble *c, double real) { NPY_CLONGDOUBLE_SET_IMAG(c, real); } +#endif template static inline typ @@ -1057,8 +1107,8 @@ mult(typ op1, typ op2) { typ rv; - SETRE(rv, RE(op1)*RE(op2) - IM(op1)*IM(op2)); - SETIM(rv, RE(op1)*IM(op2) + IM(op1)*RE(op2)); + SETRE(&rv, RE(&op1)*RE(&op2) - IM(&op1)*IM(&op2)); + SETIM(&rv, RE(&op1)*IM(&op2) + IM(&op1)*RE(&op2)); return rv; } @@ -1079,8 +1129,8 @@ slogdet_from_factored_diagonal(typ* src, { basetyp abs_element = npyabs(*src); typ sign_element; - SETRE(sign_element, RE(*src) / abs_element); - SETIM(sign_element, IM(*src) / abs_element); + SETRE(&sign_element, RE(src) / abs_element); + SETIM(&sign_element, IM(src) / abs_element); sign_acc = mult(sign_acc, sign_element); logdet_acc += npylog(abs_element); @@ -1096,14 +1146,10 @@ static inline typ det_from_slogdet(typ sign, basetyp logdet) { typ tmp; - SETRE(tmp, npyexp(logdet)); - SETIM(tmp, numeric_limits::zero); + SETRE(&tmp, npyexp(logdet)); + SETIM(&tmp, numeric_limits::zero); return mult(sign, tmp); } -#undef RE -#undef IM -#undef SETRE -#undef SETIM /* As in the linalg package, the determinant is computed via LU factorization @@ -3986,7 +4032,7 @@ abs2(typ *p, npy_intp n, complex_trait) { basetype_t res = 0; for (i = 0; i < n; i++) { typ el = p[i]; - res += el.real()*el.real() + el.imag()*el.imag(); + res += RE(&el)*RE(&el) + IM(&el)*IM(&el); } return res; } From 6ce134b64de5181ae0b57b85c6185d3ac836bda2 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 21 Jul 2023 12:22:33 +0200 Subject: [PATCH 31/40] Use structs for C++ on MSVC Co-authored-by: mattip --- numpy/core/include/numpy/ndarraytypes.h | 20 ++++++++++---------- numpy/core/include/numpy/npy_common.h | 17 +++++++++++++++++ numpy/core/src/umath/clip.cpp | 4 ++-- 3 files changed, 29 insertions(+), 12 deletions(-) diff --git a/numpy/core/include/numpy/ndarraytypes.h b/numpy/core/include/numpy/ndarraytypes.h index f7aa9e6c3601..31a0955471c4 100644 --- a/numpy/core/include/numpy/ndarraytypes.h +++ b/numpy/core/include/numpy/ndarraytypes.h @@ -964,20 +964,20 @@ typedef int (PyArray_FinalizeFunc)(PyArrayObject *, PyObject *); #define PyArray_MAX(a,b) (((a)>(b))?(a):(b)) #define PyArray_MIN(a,b) (((a)<(b))?(a):(b)) -#define PyArray_CLT(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ +#define PyArray_CLT(p,q, type) (NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ ? NPY_##type##_GET_IMAG(&(p)) < NPY_##type##_GET_IMAG(&(q)) \ - : NPY_##type##_GET_REAL(&(p)) < NPY_##type##_GET_REAL(&(q)) -#define PyArray_CGT(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ + : NPY_##type##_GET_REAL(&(p)) < NPY_##type##_GET_REAL(&(q))) +#define PyArray_CGT(p,q, type) (NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ ? NPY_##type##_GET_IMAG(&(p)) > NPY_##type##_GET_IMAG(&(q)) \ - : NPY_##type##_GET_REAL(&(p)) > NPY_##type##_GET_REAL(&(q)) -#define PyArray_CLE(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ + : NPY_##type##_GET_REAL(&(p)) > NPY_##type##_GET_REAL(&(q))) +#define PyArray_CLE(p,q, type) (NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ ? NPY_##type##_GET_IMAG(&(p)) <= NPY_##type##_GET_IMAG(&(q)) \ - : NPY_##type##_GET_REAL(&(p)) <= NPY_##type##_GET_REAL(&(q)) -#define PyArray_CGE(p,q, type) NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ + : NPY_##type##_GET_REAL(&(p)) <= NPY_##type##_GET_REAL(&(q))) +#define PyArray_CGE(p,q, type) (NPY_##type##_GET_REAL(&(p)) == NPY_##type##_GET_REAL(&(q)) \ ? NPY_##type##_GET_IMAG(&(p)) >= NPY_##type##_GET_IMAG(&(q)) \ - : NPY_##type##_GET_REAL(&(p)) >= NPY_##type##_GET_REAL(&(q)) -#define PyArray_CEQ(p,q, type) (p) == (q) -#define PyArray_CNE(p,q, type) (p) != (q) + : NPY_##type##_GET_REAL(&(p)) >= NPY_##type##_GET_REAL(&(q))) +#define PyArray_CEQ(p,q, type) ((p) == (q)) +#define PyArray_CNE(p,q, type) ((p) != (q)) /* * C API: consists of Macros and functions. The MACROS are defined diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index 5c81e7f698e4..8d06586b9862 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -381,10 +381,27 @@ typedef Py_hash_t npy_hash_t; #if defined(_MSC_VER) && !defined(__INTEL_COMPILER) +#ifdef __cplusplus +typedef struct +{ + double _Val[2]; +} npy_cdouble; + +typedef struct +{ + float _Val[2]; +} npy_cfloat; + +typedef struct +{ + long double _Val[2]; +} npy_clongdouble; +#else #include typedef _Dcomplex npy_cdouble; typedef _Fcomplex npy_cfloat; typedef _Lcomplex npy_clongdouble; +#endif #else /* !defined(__cplusplus) && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ #ifdef __cplusplus extern "C++" { diff --git a/numpy/core/src/umath/clip.cpp b/numpy/core/src/umath/clip.cpp index d90ae5c279e5..7cdba2e85010 100644 --- a/numpy/core/src/umath/clip.cpp +++ b/numpy/core/src/umath/clip.cpp @@ -71,7 +71,7 @@ _NPY_MIN(npy_cfloat a, npy_cfloat b, npy::complex_tag const &) : (b); } -#if NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE +#if defined(_MSC_VER) && !defined(__INTEL_COMPILER) && NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE npy_clongdouble _NPY_MIN(npy_clongdouble a, npy_clongdouble b, npy::complex_tag const &) { @@ -97,7 +97,7 @@ _NPY_MAX(npy_cfloat a, npy_cfloat b, npy::complex_tag const &) : (b); } -#if NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE +#if defined(_MSC_VER) && !defined(__INTEL_COMPILER) && NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE npy_clongdouble _NPY_MAX(npy_clongdouble a, npy_clongdouble b, npy::complex_tag const &) { From 1a89522e6784e62989d5f259c47e17041050cd00 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 21 Jul 2023 12:57:35 +0200 Subject: [PATCH 32/40] Fix when _NPY_MAX/MIN is defined --- numpy/core/src/umath/clip.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/numpy/core/src/umath/clip.cpp b/numpy/core/src/umath/clip.cpp index 7cdba2e85010..4de90a88a889 100644 --- a/numpy/core/src/umath/clip.cpp +++ b/numpy/core/src/umath/clip.cpp @@ -71,7 +71,7 @@ _NPY_MIN(npy_cfloat a, npy_cfloat b, npy::complex_tag const &) : (b); } -#if defined(_MSC_VER) && !defined(__INTEL_COMPILER) && NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE +#if (defined(_MSC_VER) && !defined(__INTEL_COMPILER)) || NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE npy_clongdouble _NPY_MIN(npy_clongdouble a, npy_clongdouble b, npy::complex_tag const &) { @@ -97,7 +97,7 @@ _NPY_MAX(npy_cfloat a, npy_cfloat b, npy::complex_tag const &) : (b); } -#if defined(_MSC_VER) && !defined(__INTEL_COMPILER) && NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE +#if (defined(_MSC_VER) && !defined(__INTEL_COMPILER)) || NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE npy_clongdouble _NPY_MAX(npy_clongdouble a, npy_clongdouble b, npy::complex_tag const &) { From f66f6e4992c6d3ab5598ff0cbc61a8c44754178d Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Fri, 21 Jul 2023 13:56:56 +0200 Subject: [PATCH 33/40] Revert changes to CFLAGS in pyodide build; improve formatting --- .github/workflows/emscripten.yml | 2 +- numpy/core/include/numpy/npy_common.h | 8 +++----- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/.github/workflows/emscripten.yml b/.github/workflows/emscripten.yml index 0748a8e3e0bd..c8aa34d3f8db 100644 --- a/.github/workflows/emscripten.yml +++ b/.github/workflows/emscripten.yml @@ -59,7 +59,7 @@ jobs: # Pyodide is still in the process of adding better/easier support for # non-setup.py based builds. cp pyproject.toml.setuppy pyproject.toml - CFLAGS="-g2 -Wno-error=return-type-c-linkage" LDFLAGS=-g2 pyodide build + CFLAGS=-g2 LDFLAGS=-g2 pyodide build - name: set up node uses: actions/setup-node@e33196f7422957bea03ed53f6fbb155025ffc7b8 # v3.7.0 diff --git a/numpy/core/include/numpy/npy_common.h b/numpy/core/include/numpy/npy_common.h index 8d06586b9862..fccefe71d5de 100644 --- a/numpy/core/include/numpy/npy_common.h +++ b/numpy/core/include/numpy/npy_common.h @@ -380,8 +380,7 @@ typedef Py_hash_t npy_hash_t; #endif -#if defined(_MSC_VER) && !defined(__INTEL_COMPILER) -#ifdef __cplusplus +#if defined(_MSC_VER) && !defined(__INTEL_COMPILER) && defined(__cplusplus) typedef struct { double _Val[2]; @@ -396,13 +395,12 @@ typedef struct { long double _Val[2]; } npy_clongdouble; -#else +#elif defined(_MSC_VER) && !defined(__INTEL_COMPILER) /* && !defined(__cplusplus) */ #include typedef _Dcomplex npy_cdouble; typedef _Fcomplex npy_cfloat; typedef _Lcomplex npy_clongdouble; -#endif -#else /* !defined(__cplusplus) && (!defined(_MSC_VER) || defined(__INTEL_COMPILER)) */ +#else /* !defined(_MSC_VER) || defined(__INTEL_COMPILER) */ #ifdef __cplusplus extern "C++" { #endif From 013a8d426e3189dbba92f2d65eb735a3287b9821 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Tue, 25 Jul 2023 14:22:42 +0200 Subject: [PATCH 34/40] Revert changes to Cython version now that cython3 is the default --- .github/workflows/windows_clangcl.yml | 2 -- .github/workflows/windows_meson.yml | 2 -- azure-steps-windows.yml | 5 +---- 3 files changed, 1 insertion(+), 8 deletions(-) diff --git a/.github/workflows/windows_clangcl.yml b/.github/workflows/windows_clangcl.yml index eaec6cdaebd3..2b270d99eac0 100644 --- a/.github/workflows/windows_clangcl.yml +++ b/.github/workflows/windows_clangcl.yml @@ -35,8 +35,6 @@ jobs: - name: Install dependencies run: | pip install -r build_requirements.txt - pip uninstall -y cython - pip install git+https://github.com/cython/cython.git@436f8a32ea3a1b0411695db1b974c60434042b5b - name: openblas-libs run: | # Download and install pre-built OpenBLAS library diff --git a/.github/workflows/windows_meson.yml b/.github/workflows/windows_meson.yml index b903bb6c60ec..eac0f7e640be 100644 --- a/.github/workflows/windows_meson.yml +++ b/.github/workflows/windows_meson.yml @@ -35,8 +35,6 @@ jobs: - name: Install dependencies run: | pip install -r build_requirements.txt - pip uninstall -y cython - pip install git+https://github.com/cython/cython.git@436f8a32ea3a1b0411695db1b974c60434042b5b - name: openblas-libs run: | # Download and install pre-built OpenBLAS library diff --git a/azure-steps-windows.yml b/azure-steps-windows.yml index 333012a8e666..03eba9092827 100644 --- a/azure-steps-windows.yml +++ b/azure-steps-windows.yml @@ -10,10 +10,7 @@ steps: - script: python -m pip install --upgrade pip wheel displayName: 'Install tools' -- script: | - python -m pip install -r test_requirements.txt - python -m pip uninstall -y cython - python -m pip install git+https://github.com/cython/cython.git@436f8a32ea3a1b0411695db1b974c60434042b5b +- script: python -m pip install -r test_requirements.txt displayName: 'Install dependencies; some are optional to avoid test skips' - powershell: | From 7508afd73161edeef7b3d158fa15d5bfe91b285a Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Tue, 25 Jul 2023 19:43:01 +0200 Subject: [PATCH 35/40] Remove unnecessary inline functions, use npy_c* inline functions instead --- numpy/core/include/numpy/ndarraytypes.h | 1 - numpy/core/include/numpy/npy_math.h | 165 +++++++----------- numpy/core/src/common/cblasfuncs.c | 16 +- numpy/core/src/multiarray/arraytypes.c.src | 62 ++++--- numpy/core/src/multiarray/compiled_base.c | 52 +++--- numpy/core/src/multiarray/convert_datatype.c | 12 +- numpy/core/src/multiarray/scalarapi.c | 4 +- numpy/core/src/multiarray/scalartypes.c.src | 60 ++++--- .../src/multiarray/textreading/conversions.c | 8 +- numpy/core/src/npymath/npy_math_private.h | 4 - numpy/core/src/npysort/npysort_common.h | 42 ++--- numpy/core/src/umath/clip.cpp | 20 +-- numpy/core/src/umath/funcs.inc.src | 36 ++-- numpy/core/src/umath/loops.c.src | 20 +-- numpy/core/src/umath/matmul.c.src | 13 +- numpy/core/src/umath/scalarmath.c.src | 71 ++++---- numpy/f2py/cfuncs.py | 16 +- numpy/linalg/umath_linalg.cpp | 24 +-- 18 files changed, 302 insertions(+), 324 deletions(-) diff --git a/numpy/core/include/numpy/ndarraytypes.h b/numpy/core/include/numpy/ndarraytypes.h index fdd35ddf12c6..27b18e263b26 100644 --- a/numpy/core/include/numpy/ndarraytypes.h +++ b/numpy/core/include/numpy/ndarraytypes.h @@ -2,7 +2,6 @@ #define NUMPY_CORE_INCLUDE_NUMPY_NDARRAYTYPES_H_ #include "npy_common.h" -#include "npy_math.h" #include "npy_endian.h" #include "npy_cpu.h" #include "utils.h" diff --git a/numpy/core/include/numpy/npy_math.h b/numpy/core/include/numpy/npy_math.h index 955932af0459..d98fe49cd7b3 100644 --- a/numpy/core/include/numpy/npy_math.h +++ b/numpy/core/include/numpy/npy_math.h @@ -360,147 +360,114 @@ NPY_INPLACE npy_longdouble npy_heavisidel(npy_longdouble x, npy_longdouble h0); * Complex declarations */ -typedef union { - double *arr; - const npy_cdouble *comp; -} _npy_cdouble_to_arr; - -typedef union { - float *arr; - const npy_cfloat *comp; -} _npy_cfloat_to_arr; - -typedef union { - longdouble_t *arr; - const npy_clongdouble *comp; -} _npy_clongdouble_to_arr; - -static inline double NPY_CDOUBLE_GET_REAL(const npy_cdouble *c) { - _npy_cdouble_to_arr tmp; - tmp.comp = c; - return tmp.arr[0]; +#define REAL 0 +#define IMAG 1 +#define CREATE_UNION(ctype, npy_ctype) \ + typedef union { \ + ctype *arr; \ + const npy_ctype *comp; \ + } _u; +#define NPY_COMPLEX_GET(ctype, npy_ctype, c, real_or_imag) \ + CREATE_UNION(ctype, npy_ctype) \ + _u tmp; \ + tmp.comp = &c; \ + return tmp.arr[real_or_imag]; \ + +#define NPY_COMPLEX_SET(ctype, npy_ctype, c, val, real_or_imag) \ + CREATE_UNION(ctype, npy_ctype) \ + _u tmp; \ + tmp.comp = c; \ + tmp.arr[real_or_imag] = val; \ + +static inline double npy_creal(npy_cdouble z) +{ + NPY_COMPLEX_GET(double, npy_cdouble, z, REAL) } -static inline double NPY_CDOUBLE_GET_IMAG(const npy_cdouble *c) { - _npy_cdouble_to_arr tmp; - tmp.comp = c; - return tmp.arr[1]; +static inline void npy_csetreal(npy_cdouble *z, double r) +{ + NPY_COMPLEX_SET(double, npy_cdouble, z, r, REAL) } -static inline void NPY_CDOUBLE_SET_REAL(npy_cdouble *c, double real) { - _npy_cdouble_to_arr tmp; - tmp.comp = c; - tmp.arr[0] = real; +static inline double npy_cimag(npy_cdouble z) +{ + NPY_COMPLEX_GET(double, npy_cdouble, z, IMAG) } -static inline void NPY_CDOUBLE_SET_IMAG(npy_cdouble *c, double imag) { - _npy_cdouble_to_arr tmp; - tmp.comp = c; - tmp.arr[1] = imag; +static inline void npy_csetimag(npy_cdouble *z, double i) +{ + NPY_COMPLEX_SET(double, npy_cdouble, z, i, IMAG) } -static inline float NPY_CFLOAT_GET_REAL(const npy_cfloat *c) { - _npy_cfloat_to_arr tmp; - tmp.comp = c; - return tmp.arr[0]; +static inline float npy_crealf(npy_cfloat z) +{ + NPY_COMPLEX_GET(float, npy_cfloat, z, REAL) } -static inline float NPY_CFLOAT_GET_IMAG(const npy_cfloat *c) { - _npy_cfloat_to_arr tmp; - tmp.comp = c; - return tmp.arr[1]; +static inline void npy_csetrealf(npy_cfloat *z, float r) +{ + NPY_COMPLEX_SET(float, npy_cfloat, z, r, REAL) } -static inline void NPY_CFLOAT_SET_REAL(npy_cfloat *c, float real) { - _npy_cfloat_to_arr tmp; - tmp.comp = c; - tmp.arr[0] = real; +static inline float npy_cimagf(npy_cfloat z) +{ + NPY_COMPLEX_GET(float, npy_cfloat, z, IMAG) } -static inline void NPY_CFLOAT_SET_IMAG(npy_cfloat *c, float imag) { - _npy_cfloat_to_arr tmp; - tmp.comp = c; - tmp.arr[1] = imag; +static inline void npy_csetimagf(npy_cfloat *z, float i) +{ + NPY_COMPLEX_SET(float, npy_cfloat, z, i, IMAG) } -static inline longdouble_t NPY_CLONGDOUBLE_GET_REAL(const npy_clongdouble *c) { - _npy_clongdouble_to_arr tmp; - tmp.comp = c; - return tmp.arr[0]; +static inline npy_longdouble npy_creall(npy_clongdouble z) +{ + NPY_COMPLEX_GET(longdouble_t, npy_clongdouble, z, REAL) } -static inline longdouble_t NPY_CLONGDOUBLE_GET_IMAG(const npy_clongdouble *c) { - _npy_clongdouble_to_arr tmp; - tmp.comp = c; - return tmp.arr[1]; +static inline void npy_csetreall(npy_clongdouble *z, longdouble_t r) +{ + NPY_COMPLEX_SET(longdouble_t, npy_clongdouble, z, r, REAL) } -static inline void NPY_CLONGDOUBLE_SET_REAL(npy_clongdouble *c, longdouble_t real) { - _npy_clongdouble_to_arr tmp; - tmp.comp = c; - tmp.arr[0] = real; +static inline npy_longdouble npy_cimagl(npy_clongdouble z) +{ + NPY_COMPLEX_GET(longdouble_t, npy_clongdouble, z, IMAG) } -static inline void NPY_CLONGDOUBLE_SET_IMAG(npy_clongdouble *c, longdouble_t imag) { - _npy_clongdouble_to_arr tmp; - tmp.comp = c; - tmp.arr[1] = imag; +static inline void npy_csetimagl(npy_clongdouble *z, longdouble_t i) +{ + NPY_COMPLEX_SET(longdouble_t, npy_clongdouble, z, i, IMAG) } +#undef REAL +#undef IMAG +#undef CREATE_UNION +#undef NPY_COMPLEX_GET +#undef NPY_COMPLEX_SET static inline npy_cdouble npy_cpack(double x, double y) { npy_cdouble z; - NPY_CDOUBLE_SET_REAL(&z, x); - NPY_CDOUBLE_SET_IMAG(&z, y); + npy_csetreal(&z, x); + npy_csetimag(&z, y); return z; } static inline npy_cfloat npy_cpackf(float x, float y) { npy_cfloat z; - NPY_CFLOAT_SET_REAL(&z, x); - NPY_CFLOAT_SET_IMAG(&z, y); + npy_csetrealf(&z, x); + npy_csetimagf(&z, y); return z; } static inline npy_clongdouble npy_cpackl(npy_longdouble x, npy_longdouble y) { npy_clongdouble z; - NPY_CLONGDOUBLE_SET_REAL(&z, x); - NPY_CLONGDOUBLE_SET_IMAG(&z, y); + npy_csetreall(&z, x); + npy_csetimagl(&z, y); return z; } -static inline double npy_creal(npy_cdouble z) -{ - return NPY_CDOUBLE_GET_REAL(&z); -} - -static inline double npy_cimag(npy_cdouble z) -{ - return NPY_CDOUBLE_GET_IMAG(&z); -} - -static inline float npy_crealf(npy_cfloat z) -{ - return NPY_CFLOAT_GET_REAL(&z); -} - -static inline float npy_cimagf(npy_cfloat z) -{ - return NPY_CFLOAT_GET_IMAG(&z); -} - -static inline npy_longdouble npy_creall(npy_clongdouble z) -{ - return NPY_CLONGDOUBLE_GET_REAL(&z); -} - -static inline npy_longdouble npy_cimagl(npy_clongdouble z) -{ - return NPY_CLONGDOUBLE_GET_IMAG(&z); -} - /* * Double precision complex functions */ diff --git a/numpy/core/src/common/cblasfuncs.c b/numpy/core/src/common/cblasfuncs.c index a6c550125839..8dee64a339ae 100644 --- a/numpy/core/src/common/cblasfuncs.c +++ b/numpy/core/src/common/cblasfuncs.c @@ -423,10 +423,10 @@ cblas_matrixproduct(int typenum, PyArrayObject *ap1, PyArrayObject *ap2, ptr1 = (npy_cdouble *)PyArray_DATA(ap2); ptr2 = (npy_cdouble *)PyArray_DATA(ap1); res = (npy_cdouble *)PyArray_DATA(out_buf); - NPY_CDOUBLE_SET_REAL(res, NPY_CDOUBLE_GET_REAL(ptr1) * NPY_CDOUBLE_GET_REAL(ptr2) - - NPY_CDOUBLE_GET_IMAG(ptr1) * NPY_CDOUBLE_GET_IMAG(ptr2)); - NPY_CDOUBLE_SET_IMAG(res, NPY_CDOUBLE_GET_REAL(ptr1) * NPY_CDOUBLE_GET_IMAG(ptr2) - + NPY_CDOUBLE_GET_IMAG(ptr1) * NPY_CDOUBLE_GET_REAL(ptr2)); + npy_csetreal(res, npy_creal(*ptr1) * npy_creal(*ptr2) + - npy_cimag(*ptr1) * npy_cimag(*ptr2)); + npy_csetimag(res, npy_creal(*ptr1) * npy_cimag(*ptr2) + + npy_cimag(*ptr1) * npy_creal(*ptr2)); } else if (ap1shape != _matrix) { CBLAS_FUNC(cblas_zaxpy)(l, @@ -498,10 +498,10 @@ cblas_matrixproduct(int typenum, PyArrayObject *ap1, PyArrayObject *ap2, ptr1 = (npy_cfloat *)PyArray_DATA(ap2); ptr2 = (npy_cfloat *)PyArray_DATA(ap1); res = (npy_cfloat *)PyArray_DATA(out_buf); - NPY_CFLOAT_SET_REAL(res, NPY_CFLOAT_GET_REAL(ptr1) * NPY_CFLOAT_GET_REAL(ptr2) - - NPY_CFLOAT_GET_IMAG(ptr1) * NPY_CFLOAT_GET_IMAG(ptr2)); - NPY_CFLOAT_SET_IMAG(res, NPY_CFLOAT_GET_REAL(ptr1) * NPY_CFLOAT_GET_IMAG(ptr2) - + NPY_CFLOAT_GET_IMAG(ptr1) * NPY_CFLOAT_GET_REAL(ptr2)); + npy_csetrealf(res, npy_crealf(*ptr1) * npy_crealf(*ptr2) + - npy_cimagf(*ptr1) * npy_cimagf(*ptr2)); + npy_csetimagf(res, npy_crealf(*ptr1) * npy_cimagf(*ptr2) + + npy_cimagf(*ptr1) * npy_crealf(*ptr2)); } else if (ap1shape != _matrix) { CBLAS_FUNC(cblas_caxpy)(l, diff --git a/numpy/core/src/multiarray/arraytypes.c.src b/numpy/core/src/multiarray/arraytypes.c.src index 0a64155db8d6..8ca6d4c312aa 100644 --- a/numpy/core/src/multiarray/arraytypes.c.src +++ b/numpy/core/src/multiarray/arraytypes.c.src @@ -441,6 +441,7 @@ static PyObject * * #type = npy_cfloat, npy_cdouble, npy_clongdouble# * #ftype = npy_float, npy_double, npy_longdouble# * #kind = CFloat, CDouble, CLongDouble# + * #suffix = f, , l# */ NPY_NO_EXPORT int @NAME@_setitem(PyObject *op, void *ov, void *vap) @@ -500,13 +501,13 @@ NPY_NO_EXPORT int return -1; } } - NPY_@NAME@_SET_REAL(&temp, (@ftype@) oop.real); - NPY_@NAME@_SET_IMAG(&temp, (@ftype@) oop.imag); + npy_csetreal@suffix@(&temp, (@ftype@) oop.real); + npy_csetimag@suffix@(&temp, (@ftype@) oop.imag); #if NPY_SIZEOF_@NAME@ < NPY_SIZEOF_CDOUBLE /* really just float... */ /* Overflow could have occurred converting double to float */ - if (NPY_UNLIKELY((npy_isinf(NPY_@NAME@_GET_REAL(&temp)) && !npy_isinf(oop.real)) || - (npy_isinf(NPY_@NAME@_GET_IMAG(&temp)) && !npy_isinf(oop.imag)))) { + if (NPY_UNLIKELY((npy_isinf(npy_creal@suffix@(temp)) && !npy_isinf(oop.real)) || + (npy_isinf(npy_cimag@suffix@(temp)) && !npy_isinf(oop.imag)))) { if (PyUFunc_GiveFloatingpointErrors("cast", NPY_FPE_OVERFLOW) < 0) { return -1; } @@ -1522,6 +1523,7 @@ HALF_to_BOOL(void *input, void *output, npy_intp n, * * #FROMTYPE = CFLOAT, CDOUBLE, CLONGDOUBLE# * #fromtype = npy_cfloat, npy_cdouble, npy_clongdouble# + * #ft = f, , l# */ static void @FROMTYPE@_to_BOOL(void *input, void *output, npy_intp n, @@ -1531,8 +1533,8 @@ static void npy_bool *op = output; while (n--) { - *op = (npy_bool)((NPY_@FROMTYPE@_GET_REAL(ip) != NPY_FALSE) || - (NPY_@FROMTYPE@_GET_IMAG(ip) != NPY_FALSE)); + *op = (npy_bool)((npy_creal@ft@(*ip) != NPY_FALSE) || + (npy_cimag@ft@(*ip) != NPY_FALSE)); op++; ip++; } @@ -1933,6 +1935,7 @@ BOOL_scan(FILE *fp, npy_bool *ip, void *NPY_UNUSED(ignore), /**begin repeat * #fname = CFLOAT, CDOUBLE# * #type = npy_cfloat, npy_cdouble# + * #suffix = f, # */ static int @fname@_scan(FILE *fp, @type@ *ip, void *NPY_UNUSED(ignore), @@ -1947,7 +1950,7 @@ static int char next = getc(fp); if ((next == '+') || (next == '-')) { // Imaginary component specified - NPY_@fname@_SET_REAL(&output, result); + npy_csetreal@suffix@(&output, result); // Revert peek and read imaginary component ungetc(next, fp); ret_imag = NumPyOS_ascii_ftolf(fp, &result); @@ -1955,23 +1958,23 @@ static int next = getc(fp); if ((ret_imag == 1) && (next == 'j')) { // If read is successful and the immediate following char is j - NPY_@fname@_SET_IMAG(&output, result); + npy_csetimag@suffix@(&output, result); } else { - NPY_@fname@_SET_IMAG(&output, 0); + npy_csetimag@suffix@(&output, 0); // Push an invalid char to trigger the not everything is read error ungetc('a', fp); } } else if (next == 'j') { // Real component not specified - NPY_@fname@_SET_REAL(&output, 0); - NPY_@fname@_SET_IMAG(&output, result); + npy_csetreal@suffix@(&output, 0); + npy_csetimag@suffix@(&output, result); } else { // Imaginary component not specified - NPY_@fname@_SET_REAL(&output, result); - NPY_@fname@_SET_IMAG(&output, 0.); + npy_csetreal@suffix@(&output, result); + npy_csetimag@suffix@(&output, 0.); // Next character is not + / - / j. Revert peek. ungetc(next, fp); } @@ -2076,6 +2079,7 @@ BOOL_fromstr(char *str, void *ip, char **endptr, /**begin repeat * #fname = CFLOAT, CDOUBLE# * #type = npy_cfloat, npy_cdouble# + * #suffix = f, # */ static int @fname@_fromstr(char *str, void *ip, char **endptr, @@ -2088,14 +2092,14 @@ static int if (endptr && ((*endptr[0] == '+') || (*endptr[0] == '-'))) { // Imaginary component specified - NPY_@fname@_SET_REAL(&output, result); + npy_csetreal@suffix@(&output, result); // Reading imaginary component char **prev = endptr; str = *endptr; result = NumPyOS_ascii_strtod(str, endptr); if (endptr && *endptr[0] == 'j') { // Read is successful if the immediate following char is j - NPY_@fname@_SET_IMAG(&output, result); + npy_csetimag@suffix@(&output, result); // Skip j ++*endptr; } @@ -2105,20 +2109,20 @@ static int * read error */ endptr = prev; - NPY_@fname@_SET_IMAG(&output, 0); + npy_csetimag@suffix@(&output, 0); } } else if (endptr && *endptr[0] == 'j') { // Real component not specified - NPY_@fname@_SET_REAL(&output, 0); - NPY_@fname@_SET_IMAG(&output, result); + npy_csetreal@suffix@(&output, 0); + npy_csetimag@suffix@(&output, result); // Skip j ++*endptr; } else { // Imaginary component not specified - NPY_@fname@_SET_REAL(&output, result); - NPY_@fname@_SET_IMAG(&output, 0.); + npy_csetreal@suffix@(&output, result); + npy_csetimag@suffix@(&output, 0.); } *(@type@ *)ip = output; return 0; @@ -2777,19 +2781,20 @@ static npy_bool * * #fname = CFLOAT, CDOUBLE, CLONGDOUBLE# * #type = npy_cfloat, npy_cdouble, npy_clongdouble# + * #suffix = f, , l# */ static npy_bool @fname@_nonzero (char *ip, PyArrayObject *ap) { if (ap == NULL || PyArray_ISBEHAVED_RO(ap)) { @type@ *ptmp = (@type@ *)ip; - return (npy_bool) ((NPY_@fname@_GET_REAL(ptmp) != 0) || (NPY_@fname@_GET_IMAG(ptmp) != 0)); + return (npy_bool) ((npy_creal@suffix@(*ptmp) != 0) || (npy_cimag@suffix@(*ptmp) != 0)); } else { @type@ tmp; PyArray_DESCR(ap)->f->copyswap(&tmp, ip, PyArray_ISBYTESWAPPED(ap), ap); - return (npy_bool) ((NPY_@fname@_GET_REAL(&tmp) != 0) || (NPY_@fname@_GET_IMAG(&tmp) != 0)); + return (npy_bool) ((npy_creal@suffix@(tmp) != 0) || (npy_cimag@suffix@(tmp) != 0)); } } /**end repeat**/ @@ -3975,6 +3980,7 @@ HALF_fill(npy_half *buffer, npy_intp length, void *NPY_UNUSED(ignored)) * * #NAME = CFLOAT, CDOUBLE, CLONGDOUBLE# * #type = npy_cfloat, npy_cdouble, npy_clongdouble# + * #t = f, , l# */ static int @NAME@_fill(@type@ *buffer, npy_intp length, void *NPY_UNUSED(ignore)) @@ -3983,15 +3989,15 @@ static int @type@ start; @type@ delta; - NPY_@NAME@_SET_REAL(&start, NPY_@NAME@_GET_REAL(buffer)); - NPY_@NAME@_SET_IMAG(&start, NPY_@NAME@_GET_IMAG(buffer)); - NPY_@NAME@_SET_REAL(&delta, NPY_@NAME@_GET_REAL(&buffer[1]) - NPY_@NAME@_GET_REAL(&start)); - NPY_@NAME@_SET_IMAG(&delta, NPY_@NAME@_GET_IMAG(&buffer[1]) - NPY_@NAME@_GET_IMAG(&start)); + npy_csetreal@t@(&start, npy_creal@t@(*buffer)); + npy_csetimag@t@(&start, npy_cimag@t@(*buffer)); + npy_csetreal@t@(&delta, npy_creal@t@(buffer[1]) - npy_creal@t@(start)); + npy_csetimag@t@(&delta, npy_cimag@t@(buffer[1]) - npy_cimag@t@(start)); buffer += 2; for (i = 2; i < length; i++, buffer++) { - NPY_@NAME@_SET_REAL(buffer, NPY_@NAME@_GET_REAL(&start) + i*NPY_@NAME@_GET_REAL(&delta)); - NPY_@NAME@_SET_IMAG(buffer, NPY_@NAME@_GET_IMAG(&start) + i*NPY_@NAME@_GET_IMAG(&delta)); + npy_csetreal@t@(buffer, npy_creal@t@(start) + i*npy_creal@t@(delta)); + npy_csetimag@t@(buffer, npy_cimag@t@(start) + i*npy_cimag@t@(delta)); } return 0; } diff --git a/numpy/core/src/multiarray/compiled_base.c b/numpy/core/src/multiarray/compiled_base.c index 656184fd522c..6c7ad9bf6f08 100644 --- a/numpy/core/src/multiarray/compiled_base.c +++ b/numpy/core/src/multiarray/compiled_base.c @@ -734,12 +734,12 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t lval = dy[0]; } else { - NPY_CDOUBLE_SET_REAL(&lval, PyComplex_RealAsDouble(left)); - if (error_converting(NPY_CDOUBLE_GET_REAL(&lval))) { + npy_csetreal(&lval, PyComplex_RealAsDouble(left)); + if (error_converting(npy_creal(lval))) { goto fail; } - NPY_CDOUBLE_SET_IMAG(&lval, PyComplex_ImagAsDouble(left)); - if (error_converting(NPY_CDOUBLE_GET_IMAG(&lval))) { + npy_csetimag(&lval, PyComplex_ImagAsDouble(left)); + if (error_converting(npy_cimag(lval))) { goto fail; } } @@ -748,12 +748,12 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t rval = dy[lenxp - 1]; } else { - NPY_CDOUBLE_SET_REAL(&rval, PyComplex_RealAsDouble(right)); - if (error_converting(NPY_CDOUBLE_GET_REAL(&rval))) { + npy_csetreal(&rval, PyComplex_RealAsDouble(right)); + if (error_converting(npy_creal(rval))) { goto fail; } - NPY_CDOUBLE_SET_IMAG(&rval, PyComplex_ImagAsDouble(right)); - if (error_converting(NPY_CDOUBLE_GET_IMAG(&rval))) { + npy_csetimag(&rval, PyComplex_ImagAsDouble(right)); + if (error_converting(npy_cimag(rval))) { goto fail; } } @@ -788,8 +788,8 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t if (slopes != NULL) { for (i = 0; i < lenxp - 1; ++i) { const double inv_dx = 1.0 / (dx[i+1] - dx[i]); - NPY_CDOUBLE_SET_REAL(&slopes[i], (NPY_CDOUBLE_GET_REAL(&dy[i+1]) - NPY_CDOUBLE_GET_REAL(&dy[i])) * inv_dx); - NPY_CDOUBLE_SET_IMAG(&slopes[i], (NPY_CDOUBLE_GET_IMAG(&dy[i+1]) - NPY_CDOUBLE_GET_IMAG(&dy[i])) * inv_dx); + npy_csetreal(&slopes[i], (npy_creal(dy[i+1]) - npy_creal(dy[i])) * inv_dx); + npy_csetimag(&slopes[i], (npy_cimag(dy[i+1]) - npy_cimag(dy[i])) * inv_dx); } } @@ -797,8 +797,8 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t const npy_double x_val = dz[i]; if (npy_isnan(x_val)) { - NPY_CDOUBLE_SET_REAL(&dres[i], x_val); - NPY_CDOUBLE_SET_IMAG(&dres[i], 0.0); + npy_csetreal(&dres[i], x_val); + npy_csetimag(&dres[i], 0.0); continue; } @@ -823,25 +823,25 @@ arr_interp_complex(PyObject *NPY_UNUSED(self), PyObject *const *args, Py_ssize_t } else { const npy_double inv_dx = 1.0 / (dx[j+1] - dx[j]); - NPY_CDOUBLE_SET_REAL(&slope, (NPY_CDOUBLE_GET_REAL(&dy[j+1]) - NPY_CDOUBLE_GET_REAL(&dy[j])) * inv_dx); - NPY_CDOUBLE_SET_IMAG(&slope, (NPY_CDOUBLE_GET_IMAG(&dy[j+1]) - NPY_CDOUBLE_GET_IMAG(&dy[j])) * inv_dx); + npy_csetreal(&slope, (npy_creal(dy[j+1]) - npy_creal(dy[j])) * inv_dx); + npy_csetimag(&slope, (npy_cimag(dy[j+1]) - npy_cimag(dy[j])) * inv_dx); } /* If we get nan in one direction, try the other */ - NPY_CDOUBLE_SET_REAL(&dres[i], NPY_CDOUBLE_GET_REAL(&slope)*(x_val - dx[j]) + NPY_CDOUBLE_GET_REAL(&dy[j])); - if (NPY_UNLIKELY(npy_isnan(NPY_CDOUBLE_GET_REAL(&dres[i])))) { - NPY_CDOUBLE_SET_REAL(&dres[i], NPY_CDOUBLE_GET_REAL(&slope)*(x_val - dx[j+1]) + NPY_CDOUBLE_GET_REAL(&dy[j+1])); - if (NPY_UNLIKELY(npy_isnan(NPY_CDOUBLE_GET_REAL(&dres[i]))) && - NPY_CDOUBLE_GET_REAL(&dy[j]) == NPY_CDOUBLE_GET_REAL(&dy[j+1])) { - NPY_CDOUBLE_SET_REAL(&dres[i], NPY_CDOUBLE_GET_REAL(&dy[j])); + npy_csetreal(&dres[i], npy_creal(slope)*(x_val - dx[j]) + npy_creal(dy[j])); + if (NPY_UNLIKELY(npy_isnan(npy_creal(dres[i])))) { + npy_csetreal(&dres[i], npy_creal(slope)*(x_val - dx[j+1]) + npy_creal(dy[j+1])); + if (NPY_UNLIKELY(npy_isnan(npy_creal(dres[i]))) && + npy_creal(dy[j]) == npy_creal(dy[j+1])) { + npy_csetreal(&dres[i], npy_creal(dy[j])); } } - NPY_CDOUBLE_SET_IMAG(&dres[i], NPY_CDOUBLE_GET_IMAG(&slope)*(x_val - dx[j]) + NPY_CDOUBLE_GET_IMAG(&dy[j])); - if (NPY_UNLIKELY(npy_isnan(NPY_CDOUBLE_GET_IMAG(&dres[i])))) { - NPY_CDOUBLE_SET_IMAG(&dres[i], NPY_CDOUBLE_GET_IMAG(&slope)*(x_val - dx[j+1]) + NPY_CDOUBLE_GET_IMAG(&dy[j+1])); - if (NPY_UNLIKELY(npy_isnan(NPY_CDOUBLE_GET_IMAG(&dres[i]))) && - NPY_CDOUBLE_GET_IMAG(&dy[j]) == NPY_CDOUBLE_GET_IMAG(&dy[j+1])) { - NPY_CDOUBLE_SET_IMAG(&dres[i], NPY_CDOUBLE_GET_IMAG(&dy[j])); + npy_csetimag(&dres[i], npy_cimag(slope)*(x_val - dx[j]) + npy_cimag(dy[j])); + if (NPY_UNLIKELY(npy_isnan(npy_cimag(dres[i])))) { + npy_csetimag(&dres[i], npy_cimag(slope)*(x_val - dx[j+1]) + npy_cimag(dy[j+1])); + if (NPY_UNLIKELY(npy_isnan(npy_cimag(dres[i]))) && + npy_cimag(dy[j]) == npy_cimag(dy[j+1])) { + npy_csetimag(&dres[i], npy_cimag(dy[j])); } } } diff --git a/numpy/core/src/multiarray/convert_datatype.c b/numpy/core/src/multiarray/convert_datatype.c index 3362ebc2b2d3..723648f8041e 100644 --- a/numpy/core/src/multiarray/convert_datatype.c +++ b/numpy/core/src/multiarray/convert_datatype.c @@ -1539,8 +1539,8 @@ static int min_scalar_type_num(char *valueptr, int type_num, NPY_DOUBLE, is_small_unsigned); } */ - if (NPY_CDOUBLE_GET_REAL(&value) > -3.4e38 && NPY_CDOUBLE_GET_REAL(&value) < 3.4e38 && - NPY_CDOUBLE_GET_IMAG(&value) > -3.4e38 && NPY_CDOUBLE_GET_IMAG(&value) < 3.4e38) { + if (npy_creal(value) > -3.4e38 && npy_creal(value) < 3.4e38 && + npy_cimag(value) > -3.4e38 && npy_cimag(value) < 3.4e38) { return NPY_CFLOAT; } break; @@ -1553,12 +1553,12 @@ static int min_scalar_type_num(char *valueptr, int type_num, NPY_LONGDOUBLE, is_small_unsigned); } */ - if (NPY_CLONGDOUBLE_GET_REAL(&value) > -3.4e38 && NPY_CLONGDOUBLE_GET_REAL(&value) < 3.4e38 && - NPY_CLONGDOUBLE_GET_IMAG(&value) > -3.4e38 && NPY_CLONGDOUBLE_GET_IMAG(&value) < 3.4e38) { + if (npy_creall(value) > -3.4e38 && npy_creall(value) < 3.4e38 && + npy_cimagl(value) > -3.4e38 && npy_cimagl(value) < 3.4e38) { return NPY_CFLOAT; } - else if (NPY_CLONGDOUBLE_GET_REAL(&value) > -1.7e308 && NPY_CLONGDOUBLE_GET_REAL(&value) < 1.7e308 && - NPY_CLONGDOUBLE_GET_IMAG(&value) > -1.7e308 && NPY_CLONGDOUBLE_GET_IMAG(&value) < 1.7e308) { + else if (npy_creall(value) > -1.7e308 && npy_creall(value) < 1.7e308 && + npy_cimagl(value) > -1.7e308 && npy_cimagl(value) < 1.7e308) { return NPY_CDOUBLE; } break; diff --git a/numpy/core/src/multiarray/scalarapi.c b/numpy/core/src/multiarray/scalarapi.c index e5aacd05c4d7..985d2aef2e4e 100644 --- a/numpy/core/src/multiarray/scalarapi.c +++ b/numpy/core/src/multiarray/scalarapi.c @@ -373,8 +373,8 @@ PyArray_ScalarFromObject(PyObject *object) else if (PyComplex_Check(object)) { ret = PyArrayScalar_New(CDouble); if (ret != NULL) { - NPY_CDOUBLE_SET_REAL(&PyArrayScalar_VAL(ret, CDouble), PyComplex_RealAsDouble(object)); - NPY_CDOUBLE_SET_IMAG(&PyArrayScalar_VAL(ret, CDouble), PyComplex_ImagAsDouble(object)); + npy_csetreal(&PyArrayScalar_VAL(ret, CDouble), PyComplex_RealAsDouble(object)); + npy_csetimag(&PyArrayScalar_VAL(ret, CDouble), PyComplex_ImagAsDouble(object)); } return ret; } diff --git a/numpy/core/src/multiarray/scalartypes.c.src b/numpy/core/src/multiarray/scalartypes.c.src index 682627a30b1f..870cb5222ed3 100644 --- a/numpy/core/src/multiarray/scalartypes.c.src +++ b/numpy/core/src/multiarray/scalartypes.c.src @@ -786,6 +786,7 @@ extern int npy_legacy_print_mode; * #NAME = FLOAT, DOUBLE, LONGDOUBLE# * #TYPE = CFLOAT, CDOUBLE, CLONGDOUBLE# * #type = npy_cfloat, npy_cdouble, npy_clongdouble# + * #t = f, , l# * #suff = f, d, l# */ @@ -801,14 +802,14 @@ legacy_@name@_format@kind@(@type@ val) /* * Ideally, we should handle this nan/inf stuff in NumpyOS_ascii_format* */ - if (NPY_@TYPE@_GET_REAL(&val) == 0.0 && npy_signbit(NPY_@TYPE@_GET_REAL(&val)) == 0) { + if (npy_creal@t@(val) == 0.0 && npy_signbit(npy_creal@t@(val)) == 0) { PyOS_snprintf(format, sizeof(format), _FMT1, @NAME@PREC_@KIND@); - res = NumPyOS_ascii_format@suff@(buf, sizeof(buf) - 1, format, NPY_@TYPE@_GET_IMAG(&val), 0); + res = NumPyOS_ascii_format@suff@(buf, sizeof(buf) - 1, format, npy_cimag@t@(val), 0); if (res == NULL) { PyErr_SetString(PyExc_RuntimeError, "Error while formatting"); return NULL; } - if (!npy_isfinite(NPY_@TYPE@_GET_IMAG(&val))) { + if (!npy_isfinite(npy_cimag@t@(val))) { strncat(buf, "*", sizeof(buf) - strlen(buf) - 1); } strncat(buf, "j", sizeof(buf) - strlen(buf) - 1); @@ -816,20 +817,20 @@ legacy_@name@_format@kind@(@type@ val) else { char re[64], im[64]; - if (npy_isfinite(NPY_@TYPE@_GET_REAL(&val))) { + if (npy_isfinite(npy_creal@t@(val))) { PyOS_snprintf(format, sizeof(format), _FMT1, @NAME@PREC_@KIND@); res = NumPyOS_ascii_format@suff@(re, sizeof(re), format, - NPY_@TYPE@_GET_REAL(&val), 0); + npy_creal@t@(val), 0); if (res == NULL) { PyErr_SetString(PyExc_RuntimeError, "Error while formatting"); return NULL; } } else { - if (npy_isnan(NPY_@TYPE@_GET_REAL(&val))) { + if (npy_isnan(npy_creal@t@(val))) { strcpy(re, "nan"); } - else if (NPY_@TYPE@_GET_REAL(&val) > 0){ + else if (npy_creal@t@(val) > 0){ strcpy(re, "inf"); } else { @@ -838,26 +839,26 @@ legacy_@name@_format@kind@(@type@ val) } - if (npy_isfinite(NPY_@TYPE@_GET_IMAG(&val))) { + if (npy_isfinite(npy_cimag@t@(val))) { PyOS_snprintf(format, sizeof(format), _FMT2, @NAME@PREC_@KIND@); res = NumPyOS_ascii_format@suff@(im, sizeof(im), format, - NPY_@TYPE@_GET_IMAG(&val), 0); + npy_cimag@t@(val), 0); if (res == NULL) { PyErr_SetString(PyExc_RuntimeError, "Error while formatting"); return NULL; } } else { - if (npy_isnan(NPY_@TYPE@_GET_IMAG(&val))) { + if (npy_isnan(npy_cimag@t@(val))) { strcpy(im, "+nan"); } - else if (NPY_@TYPE@_GET_IMAG(&val) > 0){ + else if (npy_cimag@t@(val) > 0){ strcpy(im, "+inf"); } else { strcpy(im, "-inf"); } - if (!npy_isfinite(NPY_@TYPE@_GET_IMAG(&val))) { + if (!npy_isfinite(npy_cimag@t@(val))) { strncat(im, "*", sizeof(im) - strlen(im) - 1); } } @@ -928,6 +929,7 @@ legacy_@name@_format@kind@(npy_@name@ val){ * #name = float, double, longdouble# * #Name = Float, Double, LongDouble# * #NAME = FLOAT, DOUBLE, LONGDOUBLE# + * #n = f, , l# */ /* helper function choose scientific of fractional output, based on a cutoff */ @@ -973,8 +975,8 @@ c@name@type_@kind@(PyObject *self) return legacy_c@name@_format@kind@(val); } - if (NPY_C@NAME@_GET_REAL(&val) == 0.0 && npy_signbit(NPY_C@NAME@_GET_REAL(&val)) == 0) { - istr = @name@type_@kind@_either(NPY_C@NAME@_GET_IMAG(&val), trim, trim, 0); + if (npy_creal@n@(val) == 0.0 && npy_signbit(npy_creal@n@(val)) == 0) { + istr = @name@type_@kind@_either(npy_cimag@n@(val), trim, trim, 0); if (istr == NULL) { return NULL; } @@ -983,13 +985,13 @@ c@name@type_@kind@(PyObject *self) return ret; } - if (npy_isfinite(NPY_C@NAME@_GET_REAL(&val))) { - rstr = @name@type_@kind@_either(NPY_C@NAME@_GET_REAL(&val), trim, trim, 0); + if (npy_isfinite(npy_creal@n@(val))) { + rstr = @name@type_@kind@_either(npy_creal@n@(val), trim, trim, 0); } - else if (npy_isnan(NPY_C@NAME@_GET_REAL(&val))) { + else if (npy_isnan(npy_creal@n@(val))) { rstr = PyUnicode_FromString("nan"); } - else if (NPY_C@NAME@_GET_REAL(&val) > 0){ + else if (npy_creal@n@(val) > 0){ rstr = PyUnicode_FromString("inf"); } else { @@ -999,13 +1001,13 @@ c@name@type_@kind@(PyObject *self) return NULL; } - if (npy_isfinite(NPY_C@NAME@_GET_IMAG(&val))) { - istr = @name@type_@kind@_either(NPY_C@NAME@_GET_IMAG(&val), trim, trim, 1); + if (npy_isfinite(npy_cimag@n@(val))) { + istr = @name@type_@kind@_either(npy_cimag@n@(val), trim, trim, 1); } - else if (npy_isnan(NPY_C@NAME@_GET_IMAG(&val))) { + else if (npy_isnan(npy_cimag@n@(val))) { istr = PyUnicode_FromString("+nan"); } - else if (NPY_C@NAME@_GET_IMAG(&val) > 0){ + else if (npy_cimag@n@(val) > 0){ istr = PyUnicode_FromString("+inf"); } else { @@ -1066,14 +1068,14 @@ longdoubletype_long(PyObject *self) static PyObject * clongdoubletype_float(PyObject *self) { - npy_longdouble val = NPY_CLONGDOUBLE_GET_REAL(&PyArrayScalar_VAL(self, CLongDouble)); + npy_longdouble val = npy_creall(PyArrayScalar_VAL(self, CLongDouble)); return PyFloat_FromDouble((double) val); } static PyObject * clongdoubletype_long(PyObject *self) { - npy_longdouble val = NPY_CLONGDOUBLE_GET_REAL(&PyArrayScalar_VAL(self, CLongDouble)); + npy_longdouble val = npy_creall(PyArrayScalar_VAL(self, CLongDouble)); return npy_longdouble_to_PyLong(val); } @@ -1942,13 +1944,14 @@ numbertype_class_getitem(PyObject *cls, PyObject *args) * #name = cfloat, clongdouble# * #Name = CFloat, CLongDouble# * #NAME = CFLOAT, CLONGDOUBLE# + * #n = f, l# */ static PyObject * @name@_complex(PyObject *self, PyObject *NPY_UNUSED(args), PyObject *NPY_UNUSED(kwds)) { - return PyComplex_FromDoubles(NPY_@NAME@_GET_REAL(&PyArrayScalar_VAL(self, @Name@)), - NPY_@NAME@_GET_IMAG(&PyArrayScalar_VAL(self, @Name@))); + return PyComplex_FromDoubles(npy_creal@n@(PyArrayScalar_VAL(self, @Name@)), + npy_cimag@n@(PyArrayScalar_VAL(self, @Name@))); } /**end repeat**/ @@ -3447,6 +3450,7 @@ static npy_hash_t * #lname = float, longdouble# * #name = Float, LongDouble# * #NAME = FLOAT, LONGDOUBLE# + * #n = f, l# */ static npy_hash_t @lname@_arrtype_hash(PyObject *obj) @@ -3460,13 +3464,13 @@ c@lname@_arrtype_hash(PyObject *obj) { npy_hash_t hashreal, hashimag, combined; hashreal = Npy_HashDouble( - obj, (double)NPY_C@NAME@_GET_REAL(&PyArrayScalar_VAL(obj, C@name@))); + obj, (double)npy_creal@n@(PyArrayScalar_VAL(obj, C@name@))); if (hashreal == -1) { return -1; } hashimag = Npy_HashDouble( - obj, (double)NPY_C@NAME@_GET_IMAG(&PyArrayScalar_VAL(obj, C@name@))); + obj, (double)npy_cimag@n@(PyArrayScalar_VAL(obj, C@name@))); if (hashimag == -1) { return -1; } diff --git a/numpy/core/src/multiarray/textreading/conversions.c b/numpy/core/src/multiarray/textreading/conversions.c index 5129034ee920..e9bea72e0bd1 100644 --- a/numpy/core/src/multiarray/textreading/conversions.c +++ b/numpy/core/src/multiarray/textreading/conversions.c @@ -244,8 +244,8 @@ npy_to_cfloat(PyArray_Descr *descr, return -1; } npy_complex64 val; - NPY_CFLOAT_SET_REAL(&val, (float) real); - NPY_CFLOAT_SET_IMAG(&val, (float) imag); + npy_csetrealf(&val, (float) real); + npy_csetimagf(&val, (float) imag); memcpy(dataptr, &val, sizeof(npy_complex64)); if (!PyArray_ISNBO(descr->byteorder)) { npy_bswap4_unaligned(dataptr); @@ -270,8 +270,8 @@ npy_to_cdouble(PyArray_Descr *descr, return -1; } npy_complex128 val; - NPY_CDOUBLE_SET_REAL(&val, real); - NPY_CDOUBLE_SET_IMAG(&val, imag); + npy_csetreal(&val, real); + npy_csetimag(&val, imag); memcpy(dataptr, &val, sizeof(npy_complex128)); if (!PyArray_ISNBO(descr->byteorder)) { npy_bswap8_unaligned(dataptr); diff --git a/numpy/core/src/npymath/npy_math_private.h b/numpy/core/src/npymath/npy_math_private.h index 8fa7316e2dc3..e55af987f3f3 100644 --- a/numpy/core/src/npymath/npy_math_private.h +++ b/numpy/core/src/npymath/npy_math_private.h @@ -172,10 +172,6 @@ do { \ (d) = sf_u.value; \ } while (0) -#ifdef NPY_USE_C99_COMPLEX -#include -#endif - /* * Long double support */ diff --git a/numpy/core/src/npysort/npysort_common.h b/numpy/core/src/npysort/npysort_common.h index e56d08bc11f9..680b4a32c8f5 100644 --- a/numpy/core/src/npysort/npysort_common.h +++ b/numpy/core/src/npysort/npysort_common.h @@ -198,17 +198,17 @@ CFLOAT_LT(npy_cfloat a, npy_cfloat b) { int ret; - if (NPY_CFLOAT_GET_REAL(&a) < NPY_CFLOAT_GET_REAL(&b)) { - ret = NPY_CFLOAT_GET_IMAG(&a) == NPY_CFLOAT_GET_IMAG(&a) || NPY_CFLOAT_GET_IMAG(&b) != NPY_CFLOAT_GET_IMAG(&b); + if (npy_crealf(a) < npy_crealf(b)) { + ret = npy_cimagf(a) == npy_cimagf(a) || npy_cimagf(b) != npy_cimagf(b); } - else if (NPY_CFLOAT_GET_REAL(&a) > NPY_CFLOAT_GET_REAL(&b)) { - ret = NPY_CFLOAT_GET_IMAG(&b) != NPY_CFLOAT_GET_IMAG(&b) && NPY_CFLOAT_GET_IMAG(&a) == NPY_CFLOAT_GET_IMAG(&a); + else if (npy_crealf(a) > npy_crealf(b)) { + ret = npy_cimagf(b) != npy_cimagf(b) && npy_cimagf(a) == npy_cimagf(a); } - else if (NPY_CFLOAT_GET_REAL(&a) == NPY_CFLOAT_GET_REAL(&b) || (NPY_CFLOAT_GET_REAL(&a) != NPY_CFLOAT_GET_REAL(&a) && NPY_CFLOAT_GET_REAL(&b) != NPY_CFLOAT_GET_REAL(&b))) { - ret = NPY_CFLOAT_GET_IMAG(&a) < NPY_CFLOAT_GET_IMAG(&b) || (NPY_CFLOAT_GET_IMAG(&b) != NPY_CFLOAT_GET_IMAG(&b) && NPY_CFLOAT_GET_IMAG(&a) == NPY_CFLOAT_GET_IMAG(&a)); + else if (npy_crealf(a) == npy_crealf(b) || (npy_crealf(a) != npy_crealf(a) && npy_crealf(b) != npy_crealf(b))) { + ret = npy_cimagf(a) < npy_cimagf(b) || (npy_cimagf(b) != npy_cimagf(b) && npy_cimagf(a) == npy_cimagf(a)); } else { - ret = NPY_CFLOAT_GET_REAL(&b) != NPY_CFLOAT_GET_REAL(&b); + ret = npy_crealf(b) != npy_crealf(b); } return ret; @@ -220,17 +220,17 @@ CDOUBLE_LT(npy_cdouble a, npy_cdouble b) { int ret; - if (NPY_CDOUBLE_GET_REAL(&a) < NPY_CDOUBLE_GET_REAL(&b)) { - ret = NPY_CDOUBLE_GET_IMAG(&a) == NPY_CDOUBLE_GET_IMAG(&a) || NPY_CDOUBLE_GET_IMAG(&b) != NPY_CDOUBLE_GET_IMAG(&b); + if (npy_creal(a) < npy_creal(b)) { + ret = npy_cimag(a) == npy_cimag(a) || npy_cimag(b) != npy_cimag(b); } - else if (NPY_CDOUBLE_GET_REAL(&a) > NPY_CDOUBLE_GET_REAL(&b)) { - ret = NPY_CDOUBLE_GET_IMAG(&b) != NPY_CDOUBLE_GET_IMAG(&b) && NPY_CDOUBLE_GET_IMAG(&a) == NPY_CDOUBLE_GET_IMAG(&a); + else if (npy_creal(a) > npy_creal(b)) { + ret = npy_cimag(b) != npy_cimag(b) && npy_cimag(a) == npy_cimag(a); } - else if (NPY_CDOUBLE_GET_REAL(&a) == NPY_CDOUBLE_GET_REAL(&b) || (NPY_CDOUBLE_GET_REAL(&a) != NPY_CDOUBLE_GET_REAL(&a) && NPY_CDOUBLE_GET_REAL(&b) != NPY_CDOUBLE_GET_REAL(&b))) { - ret = NPY_CDOUBLE_GET_IMAG(&a) < NPY_CDOUBLE_GET_IMAG(&b) || (NPY_CDOUBLE_GET_IMAG(&b) != NPY_CDOUBLE_GET_IMAG(&b) && NPY_CDOUBLE_GET_IMAG(&a) == NPY_CDOUBLE_GET_IMAG(&a)); + else if (npy_creal(a) == npy_creal(b) || (npy_creal(a) != npy_creal(a) && npy_creal(b) != npy_creal(b))) { + ret = npy_cimag(a) < npy_cimag(b) || (npy_cimag(b) != npy_cimag(b) && npy_cimag(a) == npy_cimag(a)); } else { - ret = NPY_CDOUBLE_GET_REAL(&b) != NPY_CDOUBLE_GET_REAL(&b); + ret = npy_creal(b) != npy_creal(b); } return ret; @@ -242,17 +242,17 @@ CLONGDOUBLE_LT(npy_clongdouble a, npy_clongdouble b) { int ret; - if (NPY_CLONGDOUBLE_GET_REAL(&a) < NPY_CLONGDOUBLE_GET_REAL(&b)) { - ret = NPY_CLONGDOUBLE_GET_IMAG(&a) == NPY_CLONGDOUBLE_GET_IMAG(&a) || NPY_CLONGDOUBLE_GET_IMAG(&b) != NPY_CLONGDOUBLE_GET_IMAG(&b); + if (npy_creall(a) < npy_creall(b)) { + ret = npy_cimagl(a) == npy_cimagl(a) || npy_cimagl(b) != npy_cimagl(b); } - else if (NPY_CLONGDOUBLE_GET_REAL(&a) > NPY_CLONGDOUBLE_GET_REAL(&b)) { - ret = NPY_CLONGDOUBLE_GET_IMAG(&b) != NPY_CLONGDOUBLE_GET_IMAG(&b) && NPY_CLONGDOUBLE_GET_IMAG(&a) == NPY_CLONGDOUBLE_GET_IMAG(&a); + else if (npy_creall(a) > npy_creall(b)) { + ret = npy_cimagl(b) != npy_cimagl(b) && npy_cimagl(a) == npy_cimagl(a); } - else if (NPY_CLONGDOUBLE_GET_REAL(&a) == NPY_CLONGDOUBLE_GET_REAL(&b) || (NPY_CLONGDOUBLE_GET_REAL(&a) != NPY_CLONGDOUBLE_GET_REAL(&a) && NPY_CLONGDOUBLE_GET_REAL(&b) != NPY_CLONGDOUBLE_GET_REAL(&b))) { - ret = NPY_CLONGDOUBLE_GET_IMAG(&a) < NPY_CLONGDOUBLE_GET_IMAG(&b) || (NPY_CLONGDOUBLE_GET_IMAG(&b) != NPY_CLONGDOUBLE_GET_IMAG(&b) && NPY_CLONGDOUBLE_GET_IMAG(&a) == NPY_CLONGDOUBLE_GET_IMAG(&a)); + else if (npy_creall(a) == npy_creall(b) || (npy_creall(a) != npy_creall(a) && npy_creall(b) != npy_creall(b))) { + ret = npy_cimagl(a) < npy_cimagl(b) || (npy_cimagl(b) != npy_cimagl(b) && npy_cimagl(a) == npy_cimagl(a)); } else { - ret = NPY_CLONGDOUBLE_GET_REAL(&b) != NPY_CLONGDOUBLE_GET_REAL(&b); + ret = npy_creall(b) != npy_creall(b); } return ret; diff --git a/numpy/core/src/umath/clip.cpp b/numpy/core/src/umath/clip.cpp index e121cd3249d7..2eee8f13a7dd 100644 --- a/numpy/core/src/umath/clip.cpp +++ b/numpy/core/src/umath/clip.cpp @@ -55,14 +55,14 @@ _NPY_MAX(T a, T b, npy::floating_point_tag const &) return npy_isnan(a) ? (a) : PyArray_MAX(a, b); } -#define PyArray_CLT(p,q,suffix) (((npy_creal##suffix##(p)==npy_cimag##suffix##(q)) ? (npy_cimag##suffix##(p) < npy_cimag##suffix##(q)) : \ - (npy_creal##suffix##(p) < npy_cimag##suffix##(q)))) -#define PyArray_CGT(p,q) (((npy_creal##suffix##(p)==npy_cimag##suffix##(q)) ? (npy_cimag##suffix##(p) > npy_cimag##suffix##(q)) : \ - (npy_creal##suffix##(p) > npy_cimag##suffix##(q)))) +#define PyArray_CLT(p,q,suffix) (((npy_creal##suffix(p)==npy_creal##suffix(q)) ? (npy_cimag##suffix(p) < npy_cimag##suffix(q)) : \ + (npy_creal##suffix(p) < npy_creal##suffix(q)))) +#define PyArray_CGT(p,q,suffix) (((npy_creal##suffix(p)==npy_creal##suffix(q)) ? (npy_cimag##suffix(p) > npy_cimag##suffix(q)) : \ + (npy_creal##suffix(p) > npy_creal##suffix(q)))) npy_cdouble _NPY_MIN(npy_cdouble a, npy_cdouble b, npy::complex_tag const &) { - return npy_isnan(NPY_CDOUBLE_GET_REAL(&a)) || npy_isnan(NPY_CDOUBLE_GET_IMAG(&a)) || PyArray_CLT(a, b,) + return npy_isnan(npy_creal(a)) || npy_isnan(npy_cimag(a)) || PyArray_CLT(a, b,) ? (a) : (b); } @@ -70,7 +70,7 @@ _NPY_MIN(npy_cdouble a, npy_cdouble b, npy::complex_tag const &) npy_cfloat _NPY_MIN(npy_cfloat a, npy_cfloat b, npy::complex_tag const &) { - return npy_isnan(NPY_CFLOAT_GET_REAL(&a)) || npy_isnan(NPY_CFLOAT_GET_IMAG(&a)) || PyArray_CLT(a, b, f) + return npy_isnan(npy_crealf(a)) || npy_isnan(npy_cimagf(a)) || PyArray_CLT(a, b, f) ? (a) : (b); } @@ -79,7 +79,7 @@ _NPY_MIN(npy_cfloat a, npy_cfloat b, npy::complex_tag const &) npy_clongdouble _NPY_MIN(npy_clongdouble a, npy_clongdouble b, npy::complex_tag const &) { - return npy_isnan(NPY_CLONGDOUBLE_GET_REAL(&a)) || npy_isnan(NPY_CLONGDOUBLE_GET_IMAG(&a)) || PyArray_CLT(a, b, l) + return npy_isnan(npy_creall(a)) || npy_isnan(npy_cimagl(a)) || PyArray_CLT(a, b, l) ? (a) : (b); } @@ -88,7 +88,7 @@ _NPY_MIN(npy_clongdouble a, npy_clongdouble b, npy::complex_tag const &) npy_cdouble _NPY_MAX(npy_cdouble a, npy_cdouble b, npy::complex_tag const &) { - return npy_isnan(NPY_CDOUBLE_GET_REAL(&a)) || npy_isnan(NPY_CDOUBLE_GET_IMAG(&a)) || PyArray_CGT(a, b,) + return npy_isnan(npy_creal(a)) || npy_isnan(npy_cimag(a)) || PyArray_CGT(a, b,) ? (a) : (b); } @@ -96,7 +96,7 @@ _NPY_MAX(npy_cdouble a, npy_cdouble b, npy::complex_tag const &) npy_cfloat _NPY_MAX(npy_cfloat a, npy_cfloat b, npy::complex_tag const &) { - return npy_isnan(NPY_CFLOAT_GET_REAL(&a)) || npy_isnan(NPY_CFLOAT_GET_IMAG(&a)) || PyArray_CGT(a, b, f) + return npy_isnan(npy_crealf(a)) || npy_isnan(npy_cimagf(a)) || PyArray_CGT(a, b, f) ? (a) : (b); } @@ -105,7 +105,7 @@ _NPY_MAX(npy_cfloat a, npy_cfloat b, npy::complex_tag const &) npy_clongdouble _NPY_MAX(npy_clongdouble a, npy_clongdouble b, npy::complex_tag const &) { - return npy_isnan(NPY_CLONGDOUBLE_GET_REAL(&a)) || npy_isnan(NPY_CLONGDOUBLE_GET_IMAG(&a)) || PyArray_CGT(a, b, l) + return npy_isnan(npy_creall(a)) || npy_isnan(npy_cimagl(a)) || PyArray_CGT(a, b, l) ? (a) : (b); } diff --git a/numpy/core/src/umath/funcs.inc.src b/numpy/core/src/umath/funcs.inc.src index a5887da3b27a..efd730ccc65d 100644 --- a/numpy/core/src/umath/funcs.inc.src +++ b/numpy/core/src/umath/funcs.inc.src @@ -292,16 +292,16 @@ npy_ObjectClip(PyObject *arr, PyObject *min, PyObject *max) { static void nc_neg@c@(@ctype@ *a, @ctype@ *r) { - NPY_@NAME@_SET_REAL(r, -NPY_@NAME@_GET_REAL(a)); - NPY_@NAME@_SET_IMAG(r, -NPY_@NAME@_GET_IMAG(a)); + npy_csetreal@c@(r, -npy_creal@c@(*a)); + npy_csetimag@c@(r, -npy_cimag@c@(*a)); return; } static void nc_pos@c@(@ctype@ *a, @ctype@ *r) { - NPY_@NAME@_SET_REAL(r, +NPY_@NAME@_GET_REAL(a)); - NPY_@NAME@_SET_IMAG(r, +NPY_@NAME@_GET_IMAG(a)); + npy_csetreal@c@(r, +npy_creal@c@(*a)); + npy_csetimag@c@(r, +npy_cimag@c@(*a)); return; } @@ -315,8 +315,8 @@ nc_sqrt@c@(@ctype@ *x, @ctype@ *r) static void nc_rint@c@(@ctype@ *x, @ctype@ *r) { - NPY_@NAME@_SET_REAL(r, npy_rint@c@(NPY_@NAME@_GET_REAL(x))); - NPY_@NAME@_SET_IMAG(r, npy_rint@c@(NPY_@NAME@_GET_IMAG(x))); + npy_csetreal@c@(r, npy_rint@c@(npy_creal@c@(*x))); + npy_csetimag@c@(r, npy_rint@c@(npy_cimag@c@(*x))); } static void @@ -329,9 +329,9 @@ nc_log@c@(@ctype@ *x, @ctype@ *r) static void nc_log1p@c@(@ctype@ *x, @ctype@ *r) { - @ftype@ l = npy_hypot@c@(NPY_@NAME@_GET_REAL(x) + 1,NPY_@NAME@_GET_IMAG(x)); - NPY_@NAME@_SET_IMAG(r, npy_atan2@c@(NPY_@NAME@_GET_IMAG(x), NPY_@NAME@_GET_REAL(x) + 1)); - NPY_@NAME@_SET_REAL(r, npy_log@c@(l)); + @ftype@ l = npy_hypot@c@(npy_creal@c@(*x) + 1,npy_cimag@c@(*x)); + npy_csetimag@c@(r, npy_atan2@c@(npy_cimag@c@(*x), npy_creal@c@(*x) + 1)); + npy_csetreal@c@(r, npy_log@c@(l)); return; } @@ -346,8 +346,8 @@ static void nc_exp2@c@(@ctype@ *x, @ctype@ *r) { @ctype@ a; - NPY_@NAME@_SET_REAL(&a, NPY_@NAME@_GET_REAL(x)*NPY_LOGE2@c@); - NPY_@NAME@_SET_IMAG(&a, NPY_@NAME@_GET_IMAG(x)*NPY_LOGE2@c@); + npy_csetreal@c@(&a, npy_creal@c@(*x)*NPY_LOGE2@c@); + npy_csetimag@c@(&a, npy_cimag@c@(*x)*NPY_LOGE2@c@); nc_exp@c@(&a, r); return; } @@ -355,9 +355,9 @@ nc_exp2@c@(@ctype@ *x, @ctype@ *r) static void nc_expm1@c@(@ctype@ *x, @ctype@ *r) { - @ftype@ a = npy_sin@c@(NPY_@NAME@_GET_IMAG(x) / 2); - NPY_@NAME@_SET_REAL(r, npy_expm1@c@(NPY_@NAME@_GET_REAL(x)) * npy_cos@c@(NPY_@NAME@_GET_IMAG(x)) - 2 * a * a); - NPY_@NAME@_SET_IMAG(r,npy_exp@c@(NPY_@NAME@_GET_REAL(x)) * npy_sin@c@(NPY_@NAME@_GET_IMAG(x))); + @ftype@ a = npy_sin@c@(npy_cimag@c@(*x) / 2); + npy_csetreal@c@(r, npy_expm1@c@(npy_creal@c@(*x)) * npy_cos@c@(npy_cimag@c@(*x)) - 2 * a * a); + npy_csetimag@c@(r,npy_exp@c@(npy_creal@c@(*x)) * npy_sin@c@(npy_cimag@c@(*x))); return; } @@ -429,8 +429,8 @@ static void nc_log10@c@(@ctype@ *x, @ctype@ *r) { nc_log@c@(x, r); - NPY_@NAME@_SET_REAL(r, NPY_@NAME@_GET_REAL(r) * NPY_LOG10E@c@); - NPY_@NAME@_SET_IMAG(r, NPY_@NAME@_GET_IMAG(r) * NPY_LOG10E@c@); + npy_csetreal@c@(r, npy_creal@c@(*r) * NPY_LOG10E@c@); + npy_csetimag@c@(r, npy_cimag@c@(*r) * NPY_LOG10E@c@); return; } @@ -438,8 +438,8 @@ static void nc_log2@c@(@ctype@ *x, @ctype@ *r) { nc_log@c@(x, r); - NPY_@NAME@_SET_REAL(r, NPY_@NAME@_GET_REAL(r) * NPY_LOG2E@c@); - NPY_@NAME@_SET_IMAG(r, NPY_@NAME@_GET_IMAG(r) * NPY_LOG2E@c@); + npy_csetreal@c@(r, npy_creal@c@(*r) * NPY_LOG2E@c@); + npy_csetimag@c@(r, npy_cimag@c@(*r) * NPY_LOG2E@c@); return; } diff --git a/numpy/core/src/umath/loops.c.src b/numpy/core/src/umath/loops.c.src index 85fe1ac27716..aebfd3062c02 100644 --- a/numpy/core/src/umath/loops.c.src +++ b/numpy/core/src/umath/loops.c.src @@ -158,11 +158,11 @@ PyUFunc_F_F_As_D_D(char **args, npy_intp const *dimensions, npy_intp const *step func_type *f = (func_type *)func; UNARY_LOOP { npy_cdouble tmp, out; - NPY_CDOUBLE_SET_REAL(&tmp, (double)((float *)ip1)[0]); - NPY_CDOUBLE_SET_IMAG(&tmp, (double)((float *)ip1)[1]); + npy_csetreal(&tmp, (double)((float *)ip1)[0]); + npy_csetimag(&tmp, (double)((float *)ip1)[1]); f(&tmp, &out); - ((float *)op1)[0] = (float)NPY_CDOUBLE_GET_REAL(&out); - ((float *)op1)[1] = (float)NPY_CDOUBLE_GET_IMAG(&out); + ((float *)op1)[0] = (float)npy_creal(out); + ((float *)op1)[1] = (float)npy_cimag(out); } } @@ -174,13 +174,13 @@ PyUFunc_FF_F_As_DD_D(char **args, npy_intp const *dimensions, npy_intp const *st func_type *f = (func_type *)func; BINARY_LOOP { npy_cdouble tmp1, tmp2, out; - NPY_CDOUBLE_SET_REAL(&tmp1, (double)((float *)ip1)[0]); - NPY_CDOUBLE_SET_IMAG(&tmp1, (double)((float *)ip1)[1]); - NPY_CDOUBLE_SET_REAL(&tmp2, (double)((float *)ip2)[0]); - NPY_CDOUBLE_SET_IMAG(&tmp2, (double)((float *)ip2)[1]); + npy_csetreal(&tmp1, (double)((float *)ip1)[0]); + npy_csetimag(&tmp1, (double)((float *)ip1)[1]); + npy_csetreal(&tmp2, (double)((float *)ip2)[0]); + npy_csetimag(&tmp2, (double)((float *)ip2)[1]); f(&tmp1, &tmp2, &out); - ((float *)op1)[0] = (float)NPY_CDOUBLE_GET_REAL(&out); - ((float *)op1)[1] = (float)NPY_CDOUBLE_GET_IMAG(&out); + ((float *)op1)[0] = (float)npy_creal(out); + ((float *)op1)[1] = (float)npy_cimag(out); } } diff --git a/numpy/core/src/umath/matmul.c.src b/numpy/core/src/umath/matmul.c.src index e85d27202d2a..b1b06780af14 100644 --- a/numpy/core/src/umath/matmul.c.src +++ b/numpy/core/src/umath/matmul.c.src @@ -214,6 +214,7 @@ NPY_NO_EXPORT void * npy_cfloat, npy_cdouble, npy_clongdouble, * npy_ubyte, npy_ushort, npy_uint, npy_ulong, npy_ulonglong, * npy_byte, npy_short, npy_int, npy_long, npy_longlong# + * #suff = , , , , f, , l, x*10# * #IS_COMPLEX = 0, 0, 0, 0, 1, 1, 1, 0*10# * #IS_HALF = 0, 0, 0, 1, 0*13# */ @@ -237,8 +238,8 @@ NPY_NO_EXPORT void for (m = 0; m < dm; m++) { for (p = 0; p < dp; p++) { #if @IS_COMPLEX@ == 1 - NPY_@TYPE@_SET_REAL((@typ@ *)op, 0.0); - NPY_@TYPE@_SET_IMAG((@typ@ *)op, 0.0); + npy_csetreal@suff@((@typ@ *)op, 0.0); + npy_csetimag@suff@((@typ@ *)op, 0.0); #elif @IS_HALF@ float sum = 0; #else @@ -250,10 +251,10 @@ NPY_NO_EXPORT void #if @IS_HALF@ sum += npy_half_to_float(val1) * npy_half_to_float(val2); #elif @IS_COMPLEX@ == 1 - NPY_@TYPE@_SET_REAL((@typ@ *) op, NPY_@TYPE@_GET_REAL((@typ@ *) op) + ((NPY_@TYPE@_GET_REAL(&val1) * NPY_@TYPE@_GET_REAL(&val2)) - - (NPY_@TYPE@_GET_IMAG(&val1) * NPY_@TYPE@_GET_IMAG(&val2)))); - NPY_@TYPE@_SET_IMAG((@typ@ *) op, NPY_@TYPE@_GET_IMAG((@typ@ *) op) + ((NPY_@TYPE@_GET_REAL(&val1) * NPY_@TYPE@_GET_IMAG(&val2)) + - (NPY_@TYPE@_GET_IMAG(&val1) * NPY_@TYPE@_GET_REAL(&val2)))); + npy_csetreal@suff@((@typ@ *) op, npy_creal@suff@(*((@typ@ *) op)) + ((npy_creal@suff@(val1) * npy_creal@suff@(val2)) - + (npy_cimag@suff@(val1) * npy_cimag@suff@(val2)))); + npy_csetimag@suff@((@typ@ *) op, npy_cimag@suff@(*((@typ@ *) op)) + ((npy_creal@suff@(val1) * npy_cimag@suff@(val2)) + + (npy_cimag@suff@(val1) * npy_creal@suff@(val2)))); #else *(@typ@ *)op += val1 * val2; #endif diff --git a/numpy/core/src/umath/scalarmath.c.src b/numpy/core/src/umath/scalarmath.c.src index 30e906cb7680..b8dabc1b23d1 100644 --- a/numpy/core/src/umath/scalarmath.c.src +++ b/numpy/core/src/umath/scalarmath.c.src @@ -423,16 +423,16 @@ half_ctype_divmod(npy_half a, npy_half b, npy_half *out1, npy_half *out2) static inline int @name@_ctype_add(@type@ a, @type@ b, @type@ *out) { - NPY_@TYPE@_SET_REAL(out, NPY_@TYPE@_GET_REAL(&a) + NPY_@TYPE@_GET_REAL(&b)); - NPY_@TYPE@_SET_IMAG(out, NPY_@TYPE@_GET_IMAG(&a) + NPY_@TYPE@_GET_IMAG(&b)); + npy_csetreal@c@(out, npy_creal@c@(a) + npy_creal@c@(b)); + npy_csetimag@c@(out, npy_cimag@c@(a) + npy_cimag@c@(b)); return 0; } static inline int @name@_ctype_subtract(@type@ a, @type@ b, @type@ *out) { - NPY_@TYPE@_SET_REAL(out, NPY_@TYPE@_GET_REAL(&a) - NPY_@TYPE@_GET_REAL(&b)); - NPY_@TYPE@_SET_IMAG(out, NPY_@TYPE@_GET_IMAG(&a) - NPY_@TYPE@_GET_IMAG(&b)); + npy_csetreal@c@(out, npy_creal@c@(a) - npy_creal@c@(b)); + npy_csetimag@c@(out, npy_cimag@c@(a) - npy_cimag@c@(b)); return 0; } @@ -444,8 +444,8 @@ static inline int static inline int @name@_ctype_multiply( @type@ a, @type@ b, @type@ *out) { - NPY_@TYPE@_SET_REAL(out, NPY_@TYPE@_GET_REAL(&a) * NPY_@TYPE@_GET_REAL(&b) - NPY_@TYPE@_GET_IMAG(&a) * NPY_@TYPE@_GET_IMAG(&b)); - NPY_@TYPE@_SET_IMAG(out, NPY_@TYPE@_GET_REAL(&a) * NPY_@TYPE@_GET_IMAG(&b) + NPY_@TYPE@_GET_IMAG(&a) * NPY_@TYPE@_GET_REAL(&b)); + npy_csetreal@c@(out, npy_creal@c@(a) * npy_creal@c@(b) - npy_cimag@c@(a) * npy_cimag@c@(b)); + npy_csetimag@c@(out, npy_creal@c@(a) * npy_cimag@c@(b) + npy_cimag@c@(a) * npy_creal@c@(b)); return 0; } @@ -554,12 +554,13 @@ half_ctype_negative(npy_half a, npy_half *out) * #NAME = CFLOAT, CDOUBLE, CLONGDOUBLE# * #name = cfloat, cdouble, clongdouble# * #type = npy_cfloat, npy_cdouble, npy_clongdouble# + * #c = f, , l# */ static inline int @name@_ctype_negative(@type@ a, @type@ *out) { - NPY_@NAME@_SET_REAL(out, -NPY_@NAME@_GET_REAL(&a)); - NPY_@NAME@_SET_IMAG(out, -NPY_@NAME@_GET_IMAG(&a)); + npy_csetreal@c@(out, -npy_creal@c@(a)); + npy_csetimag@c@(out, -npy_cimag@c@(a)); return 0; } /**end repeat**/ @@ -589,8 +590,8 @@ static inline int static inline int @name@_ctype_positive(@type@ a, @type@ *out) { - NPY_@NAME@_SET_REAL(out, +NPY_@NAME@_GET_REAL(&a)); - NPY_@NAME@_SET_IMAG(out, +NPY_@NAME@_GET_IMAG(&a)); + npy_csetreal@c@(out, +npy_creal@c@(a)); + npy_csetimag@c@(out, +npy_cimag@c@(a)); return 0; } @@ -836,6 +837,7 @@ typedef enum { * npy_long, npy_ulong, npy_longlong, npy_ulonglong, * npy_half, npy_float, npy_double, npy_longdouble, * npy_cfloat, npy_cdouble, npy_clongdouble# + * #c = x*14, f, , l# */ #define IS_@TYPE@ 1 @@ -855,8 +857,8 @@ typedef enum { *result = npy_float_to_half((float)(value)) #elif defined(IS_CFLOAT) || defined(IS_CDOUBLE) || defined(IS_CLONGDOUBLE) #define CONVERT_TO_RESULT(value) \ - NPY_@TYPE@_SET_REAL(result, value); \ - NPY_@TYPE@_SET_IMAG(result, 0) + npy_csetreal@c@(result, value); \ + npy_csetimag@c@(result, 0) #else #define CONVERT_TO_RESULT(value) *result = value #endif @@ -887,12 +889,12 @@ typedef enum { #if defined(IS_CFLOAT) || defined(IS_CDOUBLE) || defined(IS_CLONGDOUBLE) -#define GET_CVALUE_OR_DEFER(OTHER, Other, value) \ +#define GET_CVALUE_OR_DEFER(OTHER, Other, o, value) \ case NPY_##OTHER: \ if (IS_SAFE(NPY_##OTHER, NPY_@TYPE@)) { \ assert(Py_TYPE(value) == &Py##Other##ArrType_Type); \ - NPY_@TYPE@_SET_REAL(result, NPY_##OTHER##_GET_REAL(&PyArrayScalar_VAL(value, Other))); \ - NPY_@TYPE@_SET_IMAG(result, NPY_##OTHER##_GET_IMAG(&PyArrayScalar_VAL(value, Other))); \ + npy_csetreal@c@(result, npy_creal##o(PyArrayScalar_VAL(value, Other))); \ + npy_csetimag@c@(result, npy_cimag##o(PyArrayScalar_VAL(value, Other))); \ ret = 1; \ } \ else if (IS_SAFE(NPY_@TYPE@, NPY_##OTHER)) { \ @@ -906,7 +908,7 @@ typedef enum { #else /* Getting a complex value to real is never safe: */ -#define GET_CVALUE_OR_DEFER(OTHER, Other, value) \ +#define GET_CVALUE_OR_DEFER(OTHER, Other, o, value) \ case NPY_##OTHER: \ if (IS_SAFE(NPY_@TYPE@, NPY_##OTHER)) { \ ret = DEFER_TO_OTHER_KNOWN_SCALAR; \ @@ -1043,8 +1045,8 @@ convert_to_@name@(PyObject *value, @type@ *result, npy_bool *may_need_deferring) if (error_converting(val.real)) { return CONVERSION_ERROR; /* should not be possible */ } - NPY_@TYPE@_SET_REAL(result, val.real); - NPY_@TYPE@_SET_IMAG(result, val.imag); + npy_csetreal@c@(result, val.real); + npy_csetimag@c@(result, val.imag); return CONVERSION_SUCCESS; #else /* unreachable, always unsafe cast above; return to avoid warning */ @@ -1141,9 +1143,9 @@ convert_to_@name@(PyObject *value, @type@ *result, npy_bool *may_need_deferring) GET_VALUE_OR_DEFER(DOUBLE, Double, value); GET_VALUE_OR_DEFER(LONGDOUBLE, LongDouble, value); /* Complex: We should still defer, but the code won't work... */ - GET_CVALUE_OR_DEFER(CFLOAT, CFloat, value); - GET_CVALUE_OR_DEFER(CDOUBLE, CDouble, value); - GET_CVALUE_OR_DEFER(CLONGDOUBLE, CLongDouble, value); + GET_CVALUE_OR_DEFER(CFLOAT, CFloat, f, value); + GET_CVALUE_OR_DEFER(CDOUBLE, CDouble,, value); + GET_CVALUE_OR_DEFER(CLONGDOUBLE, CLongDouble, l, value); default: /* * If there is no match, this is an unknown scalar object. It @@ -1684,6 +1686,7 @@ static PyObject * * npy_uint, npy_long, npy_ulong, npy_longlong, npy_ulonglong, * npy_half, npy_float, npy_double, npy_longdouble, * npy_cfloat, npy_cdouble, npy_clongdouble# + * #t = x*14, f, , l# * #simp = 1*14, 0*3# * #nonzero = _IS_NONZERO*10, !npy_half_iszero, _IS_NONZERO*6# */ @@ -1698,7 +1701,7 @@ static int #if @simp@ ret = @nonzero@(val); #else - ret = (@nonzero@(NPY_@NAME@_GET_REAL(&val)) || @nonzero@(NPY_@NAME@_GET_IMAG(&val))); + ret = (@nonzero@(npy_creal@t@(val)) || @nonzero@(npy_cimag@t@(val))); #endif return ret; @@ -1734,6 +1737,7 @@ emit_complexwarning(void) * UInt, Long, ULong, LongLong, ULongLong, * Half, Float, Double, LongDouble, * CFloat, CDouble, CLongDouble# + * #n = x*14, f, , l# * * #cmplx = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1# * #sign = (signed, unsigned)*5, , , , , , , # @@ -1751,7 +1755,7 @@ static PyObject * PyObject *long_result; #if @cmplx@ - @sign@ @ctype@ x = @to_ctype@(NPY_@NAME@_GET_REAL(&PyArrayScalar_VAL(obj, @Name@))); + @sign@ @ctype@ x = @to_ctype@(npy_creal@n@(PyArrayScalar_VAL(obj, @Name@))); #else @sign@ @ctype@ x = @to_ctype@(PyArrayScalar_VAL(obj, @Name@)); #endif @@ -1785,6 +1789,7 @@ static PyObject * * Long, ULong, LongLong, ULongLong, * Half, Float, Double, LongDouble, * CFloat, CDouble, CLongDouble# + * #n = x*14, f, , l# * #cmplx = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1# * #to_ctype = , , , , , , , , , , npy_half_to_double, , , , , , # * #func = PyFloat_FromDouble*17# @@ -1796,7 +1801,7 @@ static PyObject * if (emit_complexwarning() < 0) { return NULL; } - return @func@(@to_ctype@(NPY_@NAME@_GET_REAL(&PyArrayScalar_VAL(obj, @Name@)))); + return @func@(@to_ctype@(npy_creal@n@(PyArrayScalar_VAL(obj, @Name@)))); #else return @func@(@to_ctype@(PyArrayScalar_VAL(obj, @Name@))); #endif @@ -1816,15 +1821,15 @@ static PyObject * * npy_half_gt, npy_half_eq, npy_half_ne# */ #define def_cmp_@oper@(arg1, arg2) (arg1 @op@ arg2) -#define cmplx_cmp_@oper@(arg1, arg2) ((NPY_CDOUBLE_GET_REAL(&arg1) == NPY_CDOUBLE_GET_REAL(&arg2)) ? \ - NPY_CDOUBLE_GET_IMAG(&arg1) @op@ NPY_CDOUBLE_GET_IMAG(&arg2) : \ - NPY_CDOUBLE_GET_REAL(&arg1) @op@ NPY_CDOUBLE_GET_REAL(&arg2)) -#define fcmplx_cmp_@oper@(arg1, arg2) ((NPY_CFLOAT_GET_REAL(&arg1) == NPY_CFLOAT_GET_REAL(&arg2)) ? \ - NPY_CFLOAT_GET_IMAG(&arg1) @op@ NPY_CFLOAT_GET_IMAG(&arg2) : \ - NPY_CFLOAT_GET_REAL(&arg1) @op@ NPY_CFLOAT_GET_REAL(&arg2)) -#define lcmplx_cmp_@oper@(arg1, arg2) ((NPY_CLONGDOUBLE_GET_REAL(&arg1) == NPY_CLONGDOUBLE_GET_REAL(&arg2)) ? \ - NPY_CLONGDOUBLE_GET_IMAG(&arg1) @op@ NPY_CLONGDOUBLE_GET_IMAG(&arg2) : \ - NPY_CLONGDOUBLE_GET_REAL(&arg1) @op@ NPY_CLONGDOUBLE_GET_REAL(&arg2)) +#define cmplx_cmp_@oper@(arg1, arg2) ((npy_creal(arg1) == npy_creal(arg2)) ? \ + npy_cimag(arg1) @op@ npy_cimag(arg2) : \ + npy_creal(arg1) @op@ npy_creal(arg2)) +#define fcmplx_cmp_@oper@(arg1, arg2) ((npy_crealf(arg1) == npy_crealf(arg2)) ? \ + npy_cimagf(arg1) @op@ npy_cimagf(arg2) : \ + npy_crealf(arg1) @op@ npy_crealf(arg2)) +#define lcmplx_cmp_@oper@(arg1, arg2) ((npy_creall(arg1) == npy_creall(arg2)) ? \ + npy_cimagl(arg1) @op@ npy_cimagl(arg2) : \ + npy_creall(arg1) @op@ npy_creall(arg2)) #define def_half_cmp_@oper@(arg1, arg2) @halfop@(arg1, arg2) /**end repeat**/ diff --git a/numpy/f2py/cfuncs.py b/numpy/f2py/cfuncs.py index 45290307c8a9..f89793061bad 100644 --- a/numpy/f2py/cfuncs.py +++ b/numpy/f2py/cfuncs.py @@ -1109,8 +1109,8 @@ return 1; } else if (PyArray_Check(obj) && PyArray_TYPE(obj)==NPY_CLONGDOUBLE) { - (*v).r = NPY_CLONGDOUBLE_GET_REAL(((npy_clongdouble *)PyArray_DATA(obj))); - (*v).i = NPY_CLONGDOUBLE_GET_IMAG(((npy_clongdouble *)PyArray_DATA(obj))); + (*v).r = npy_creall(*(((npy_clongdouble *)PyArray_DATA(obj)))); + (*v).i = npy_cimagl(*(((npy_clongdouble *)PyArray_DATA(obj)))); return 1; } } @@ -1139,14 +1139,14 @@ if (PyArray_IsScalar(obj, CFloat)) { npy_cfloat new; PyArray_ScalarAsCtype(obj, &new); - (*v).r = (double)NPY_CFLOAT_GET_REAL(&new); - (*v).i = (double)NPY_CFLOAT_GET_IMAG(&new); + (*v).r = (double)npy_crealf(new); + (*v).i = (double)npy_cimagf(new); } else if (PyArray_IsScalar(obj, CLongDouble)) { npy_clongdouble new; PyArray_ScalarAsCtype(obj, &new); - (*v).r = (double)NPY_CLONGDOUBLE_GET_REAL(&new); - (*v).i = (double)NPY_CLONGDOUBLE_GET_IMAG(&new); + (*v).r = (double)npy_creall(new); + (*v).i = (double)npy_cimagl(new); } else { /* if (PyArray_IsScalar(obj, CDouble)) */ PyArray_ScalarAsCtype(obj, v); @@ -1164,8 +1164,8 @@ if (arr == NULL) { return 0; } - (*v).r = NPY_CDOUBLE_GET_REAL(((npy_cdouble *)PyArray_DATA(arr))); - (*v).i = NPY_CDOUBLE_GET_IMAG(((npy_cdouble *)PyArray_DATA(arr))); + (*v).r = npy_creal(*(((npy_cdouble *)PyArray_DATA(arr)))); + (*v).i = npy_cimag(*(((npy_cdouble *)PyArray_DATA(arr)))); Py_DECREF(arr); return 1; } diff --git a/numpy/linalg/umath_linalg.cpp b/numpy/linalg/umath_linalg.cpp index 89264e24d25e..4d403dcb64b0 100644 --- a/numpy/linalg/umath_linalg.cpp +++ b/numpy/linalg/umath_linalg.cpp @@ -1080,25 +1080,25 @@ det_from_slogdet(typ sign, typ logdet) npy_float npyabs(npy_cfloat z) { return npy_cabsf(z);} npy_double npyabs(npy_cdouble z) { return npy_cabs(z);} -inline float RE(npy_cfloat *c) { return NPY_CFLOAT_GET_REAL(c); } -inline double RE(npy_cdouble *c) { return NPY_CDOUBLE_GET_REAL(c); } +inline float RE(npy_cfloat *c) { return npy_crealf(*c); } +inline double RE(npy_cdouble *c) { return npy_creal(*c); } #if NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE -inline longdouble_t RE(npy_clongdouble *c) { return NPY_CLONGDOUBLE_GET_REAL(c); } +inline longdouble_t RE(npy_clongdouble *c) { return npy_creall(*c); } #endif -inline float IM(npy_cfloat *c) { return NPY_CFLOAT_GET_IMAG(c); } -inline double IM(npy_cdouble *c) { return NPY_CDOUBLE_GET_IMAG(c); } +inline float IM(npy_cfloat *c) { return npy_cimagf(*c); } +inline double IM(npy_cdouble *c) { return npy_cimag(*c); } #if NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE -inline longdouble_t IM(npy_clongdouble *c) { return NPY_CLONGDOUBLE_GET_IMAG(c); } +inline longdouble_t IM(npy_clongdouble *c) { return npy_cimagl(*c); } #endif -inline void SETRE(npy_cfloat *c, float real) { NPY_CFLOAT_SET_REAL(c, real); } -inline void SETRE(npy_cdouble *c, double real) { NPY_CDOUBLE_SET_REAL(c, real); } +inline void SETRE(npy_cfloat *c, float real) { npy_csetrealf(c, real); } +inline void SETRE(npy_cdouble *c, double real) { npy_csetreal(c, real); } #if NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE -inline void SETRE(npy_clongdouble *c, double real) { NPY_CLONGDOUBLE_SET_REAL(c, real); } +inline void SETRE(npy_clongdouble *c, double real) { npy_csetreall(c, real); } #endif -inline void SETIM(npy_cfloat *c, float real) { NPY_CFLOAT_SET_IMAG(c, real); } -inline void SETIM(npy_cdouble *c, double real) { NPY_CDOUBLE_SET_IMAG(c, real); } +inline void SETIM(npy_cfloat *c, float real) { npy_csetimagf(c, real); } +inline void SETIM(npy_cdouble *c, double real) { npy_csetimag(c, real); } #if NPY_SIZEOF_COMPLEX_LONGDOUBLE != NPY_SIZEOF_COMPLEX_DOUBLE -inline void SETIM(npy_clongdouble *c, double real) { NPY_CLONGDOUBLE_SET_IMAG(c, real); } +inline void SETIM(npy_clongdouble *c, double real) { npy_csetimagl(c, real); } #endif template From 04f4ce1d9db8aeeba698b7f4a0851e684562d862 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Wed, 26 Jul 2023 13:21:51 +0200 Subject: [PATCH 36/40] Add const wherever possible --- numpy/core/include/numpy/npy_math.h | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/numpy/core/include/numpy/npy_math.h b/numpy/core/include/numpy/npy_math.h index d98fe49cd7b3..4a163c1bf8c2 100644 --- a/numpy/core/include/numpy/npy_math.h +++ b/numpy/core/include/numpy/npy_math.h @@ -379,62 +379,62 @@ NPY_INPLACE npy_longdouble npy_heavisidel(npy_longdouble x, npy_longdouble h0); tmp.comp = c; \ tmp.arr[real_or_imag] = val; \ -static inline double npy_creal(npy_cdouble z) +static inline double npy_creal(const npy_cdouble z) { NPY_COMPLEX_GET(double, npy_cdouble, z, REAL) } -static inline void npy_csetreal(npy_cdouble *z, double r) +static inline void npy_csetreal(npy_cdouble *z, const double r) { NPY_COMPLEX_SET(double, npy_cdouble, z, r, REAL) } -static inline double npy_cimag(npy_cdouble z) +static inline double npy_cimag(const npy_cdouble z) { NPY_COMPLEX_GET(double, npy_cdouble, z, IMAG) } -static inline void npy_csetimag(npy_cdouble *z, double i) +static inline void npy_csetimag(npy_cdouble *z, const double i) { NPY_COMPLEX_SET(double, npy_cdouble, z, i, IMAG) } -static inline float npy_crealf(npy_cfloat z) +static inline float npy_crealf(const npy_cfloat z) { NPY_COMPLEX_GET(float, npy_cfloat, z, REAL) } -static inline void npy_csetrealf(npy_cfloat *z, float r) +static inline void npy_csetrealf(npy_cfloat *z, const float r) { NPY_COMPLEX_SET(float, npy_cfloat, z, r, REAL) } -static inline float npy_cimagf(npy_cfloat z) +static inline float npy_cimagf(const npy_cfloat z) { NPY_COMPLEX_GET(float, npy_cfloat, z, IMAG) } -static inline void npy_csetimagf(npy_cfloat *z, float i) +static inline void npy_csetimagf(npy_cfloat *z, const float i) { NPY_COMPLEX_SET(float, npy_cfloat, z, i, IMAG) } -static inline npy_longdouble npy_creall(npy_clongdouble z) +static inline npy_longdouble npy_creall(const npy_clongdouble z) { NPY_COMPLEX_GET(longdouble_t, npy_clongdouble, z, REAL) } -static inline void npy_csetreall(npy_clongdouble *z, longdouble_t r) +static inline void npy_csetreall(npy_clongdouble *z, const longdouble_t r) { NPY_COMPLEX_SET(longdouble_t, npy_clongdouble, z, r, REAL) } -static inline npy_longdouble npy_cimagl(npy_clongdouble z) +static inline npy_longdouble npy_cimagl(const npy_clongdouble z) { NPY_COMPLEX_GET(longdouble_t, npy_clongdouble, z, IMAG) } -static inline void npy_csetimagl(npy_clongdouble *z, longdouble_t i) +static inline void npy_csetimagl(npy_clongdouble *z, const longdouble_t i) { NPY_COMPLEX_SET(longdouble_t, npy_clongdouble, z, i, IMAG) } From 991c4b12002bef8b49be8debdb88f5d124a84734 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Thu, 27 Jul 2023 14:49:25 +0200 Subject: [PATCH 37/40] Add complex compat header --- numpy/core/include/meson.build | 1 + .../core/include/numpy/npy_2_complexcompat.h | 27 +++++++++++++++++++ 2 files changed, 28 insertions(+) create mode 100644 numpy/core/include/numpy/npy_2_complexcompat.h diff --git a/numpy/core/include/meson.build b/numpy/core/include/meson.build index 3051e6d8d7dc..808451104b01 100644 --- a/numpy/core/include/meson.build +++ b/numpy/core/include/meson.build @@ -8,6 +8,7 @@ installed_headers = [ 'numpy/ndarrayobject.h', 'numpy/ndarraytypes.h', 'numpy/npy_1_7_deprecated_api.h', + 'numpy/npy_2_complexcompat.h', 'numpy/npy_3kcompat.h', 'numpy/npy_common.h', 'numpy/npy_cpu.h', diff --git a/numpy/core/include/numpy/npy_2_complexcompat.h b/numpy/core/include/numpy/npy_2_complexcompat.h new file mode 100644 index 000000000000..0765243e21e8 --- /dev/null +++ b/numpy/core/include/numpy/npy_2_complexcompat.h @@ -0,0 +1,27 @@ +/* This header is designed to be copy-pasted into downstream packages, since it provides + a compatibility layer between the old C struct complex types and the new native C99 + complex types. */ +#ifndef NUMPY_CORE_INCLUDE_NUMPY_NPY_2_COMPLEXCOMPAT_H_ +#define NUMPY_CORE_INCLUDE_NUMPY_NPY_2_COMPLEXCOMPAT_H_ + +#include + +#if (defined(NPY_TARGET_VERSION) && NPY_TARGET_VERSION >= 0x00000012) || (NPY_FEATURE_VERSION >= 0x00000012) /* Numpy 2.0 */ +#include + +#define NPY_CSETREALF(c, r) npy_csetrealf(c, r) +#define NPY_CSETIMAGF(c, i) npy_csetimagf(c, i) +#define NPY_CSETREAL(c, r) npy_csetreal(c, r) +#define NPY_CSETIMAG(c, i) npy_csetimag(c, i) +#define NPY_CSETREALL(c, r) npy_csetreall(c, r) +#define NPY_CSETIMAGL(c, i) npy_csetimagl(c, i) +#else +#define NPY_CSETREALF(c, r) (c)->real = (r) +#define NPY_CSETIMAGF(c, i) (c)->imag = (i) +#define NPY_CSETREAL(c, r) (c)->real = (r) +#define NPY_CSETIMAG(c, i) (c)->imag = (i) +#define NPY_CSETREALL(c, r) (c)->real = (r) +#define NPY_CSETIMAGL(c, i) (c)->imag = (i) +#endif + +#endif From e2ad3c8bbf55ad239b8816ec51033cddf44c1958 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Thu, 27 Jul 2023 18:26:17 +0200 Subject: [PATCH 38/40] Change compat header to not use versions --- .../core/include/numpy/npy_2_complexcompat.h | 21 ++++++++++--------- numpy/core/include/numpy/npy_math.h | 8 +++++++ 2 files changed, 19 insertions(+), 10 deletions(-) diff --git a/numpy/core/include/numpy/npy_2_complexcompat.h b/numpy/core/include/numpy/npy_2_complexcompat.h index 0765243e21e8..b23f3fab5738 100644 --- a/numpy/core/include/numpy/npy_2_complexcompat.h +++ b/numpy/core/include/numpy/npy_2_complexcompat.h @@ -4,23 +4,24 @@ #ifndef NUMPY_CORE_INCLUDE_NUMPY_NPY_2_COMPLEXCOMPAT_H_ #define NUMPY_CORE_INCLUDE_NUMPY_NPY_2_COMPLEXCOMPAT_H_ -#include - -#if (defined(NPY_TARGET_VERSION) && NPY_TARGET_VERSION >= 0x00000012) || (NPY_FEATURE_VERSION >= 0x00000012) /* Numpy 2.0 */ #include -#define NPY_CSETREALF(c, r) npy_csetrealf(c, r) -#define NPY_CSETIMAGF(c, i) npy_csetimagf(c, i) -#define NPY_CSETREAL(c, r) npy_csetreal(c, r) -#define NPY_CSETIMAG(c, i) npy_csetimag(c, i) -#define NPY_CSETREALL(c, r) npy_csetreall(c, r) -#define NPY_CSETIMAGL(c, i) npy_csetimagl(c, i) -#else +#ifndef NPY_CSETREALF #define NPY_CSETREALF(c, r) (c)->real = (r) +#endif +#ifndef NPY_CSETIMAGF #define NPY_CSETIMAGF(c, i) (c)->imag = (i) +#endif +#ifndef NPY_CSETREAL #define NPY_CSETREAL(c, r) (c)->real = (r) +#endif +#ifndef NPY_CSETIMAG #define NPY_CSETIMAG(c, i) (c)->imag = (i) +#endif +#ifndef NPY_CSETREALL #define NPY_CSETREALL(c, r) (c)->real = (r) +#endif +#ifndef NPY_CSETIMAGL #define NPY_CSETIMAGL(c, i) (c)->imag = (i) #endif diff --git a/numpy/core/include/numpy/npy_math.h b/numpy/core/include/numpy/npy_math.h index 4a163c1bf8c2..d87cdcc67e94 100644 --- a/numpy/core/include/numpy/npy_math.h +++ b/numpy/core/include/numpy/npy_math.h @@ -438,6 +438,14 @@ static inline void npy_csetimagl(npy_clongdouble *z, const longdouble_t i) { NPY_COMPLEX_SET(longdouble_t, npy_clongdouble, z, i, IMAG) } + +#define NPY_CSETREAL(z, r) npy_csetreal(z, r) +#define NPY_CSETIMAG(z, i) npy_csetimag(z, i) +#define NPY_CSETREALF(z, r) npy_csetrealf(z, r) +#define NPY_CSETIMAGF(z, i) npy_csetimagf(z, i) +#define NPY_CSETREALL(z, r) npy_csetreall(z, r) +#define NPY_CSETIMAGL(z, i) npy_csetimagl(z, i) + #undef REAL #undef IMAG #undef CREATE_UNION From 2d25d2ae63966ed046d17eba274d4afce9418a07 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Mon, 31 Jul 2023 14:35:07 +0200 Subject: [PATCH 39/40] Improve comment in compat header Co-authored-by: mattip --- numpy/core/include/numpy/npy_2_complexcompat.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/numpy/core/include/numpy/npy_2_complexcompat.h b/numpy/core/include/numpy/npy_2_complexcompat.h index b23f3fab5738..0b509011b280 100644 --- a/numpy/core/include/numpy/npy_2_complexcompat.h +++ b/numpy/core/include/numpy/npy_2_complexcompat.h @@ -1,6 +1,6 @@ /* This header is designed to be copy-pasted into downstream packages, since it provides a compatibility layer between the old C struct complex types and the new native C99 - complex types. */ + complex types. The new macros are in numpy/npy_math.h, which is why it is included here. */ #ifndef NUMPY_CORE_INCLUDE_NUMPY_NPY_2_COMPLEXCOMPAT_H_ #define NUMPY_CORE_INCLUDE_NUMPY_NPY_2_COMPLEXCOMPAT_H_ From 530cbc5517972e74cdb6120ae4cb5dcb7ca04cb3 Mon Sep 17 00:00:00 2001 From: Lysandros Nikolaou Date: Mon, 31 Jul 2023 15:21:50 +0200 Subject: [PATCH 40/40] Address feedback --- numpy/core/include/numpy/npy_math.h | 49 +++++++-------------------- numpy/core/src/umath/clip.cpp | 1 + numpy/core/src/umath/scalarmath.c.src | 4 --- 3 files changed, 13 insertions(+), 41 deletions(-) diff --git a/numpy/core/include/numpy/npy_math.h b/numpy/core/include/numpy/npy_math.h index d87cdcc67e94..216b173fde58 100644 --- a/numpy/core/include/numpy/npy_math.h +++ b/numpy/core/include/numpy/npy_math.h @@ -360,83 +360,64 @@ NPY_INPLACE npy_longdouble npy_heavisidel(npy_longdouble x, npy_longdouble h0); * Complex declarations */ -#define REAL 0 -#define IMAG 1 -#define CREATE_UNION(ctype, npy_ctype) \ - typedef union { \ - ctype *arr; \ - const npy_ctype *comp; \ - } _u; -#define NPY_COMPLEX_GET(ctype, npy_ctype, c, real_or_imag) \ - CREATE_UNION(ctype, npy_ctype) \ - _u tmp; \ - tmp.comp = &c; \ - return tmp.arr[real_or_imag]; \ - -#define NPY_COMPLEX_SET(ctype, npy_ctype, c, val, real_or_imag) \ - CREATE_UNION(ctype, npy_ctype) \ - _u tmp; \ - tmp.comp = c; \ - tmp.arr[real_or_imag] = val; \ - static inline double npy_creal(const npy_cdouble z) { - NPY_COMPLEX_GET(double, npy_cdouble, z, REAL) + return ((double *) &z)[0]; } static inline void npy_csetreal(npy_cdouble *z, const double r) { - NPY_COMPLEX_SET(double, npy_cdouble, z, r, REAL) + ((double *) z)[0] = r; } static inline double npy_cimag(const npy_cdouble z) { - NPY_COMPLEX_GET(double, npy_cdouble, z, IMAG) + return ((double *) &z)[1]; } static inline void npy_csetimag(npy_cdouble *z, const double i) { - NPY_COMPLEX_SET(double, npy_cdouble, z, i, IMAG) + ((double *) z)[1] = i; } static inline float npy_crealf(const npy_cfloat z) { - NPY_COMPLEX_GET(float, npy_cfloat, z, REAL) + return ((float *) &z)[0]; } static inline void npy_csetrealf(npy_cfloat *z, const float r) { - NPY_COMPLEX_SET(float, npy_cfloat, z, r, REAL) + ((float *) z)[0] = r; } static inline float npy_cimagf(const npy_cfloat z) { - NPY_COMPLEX_GET(float, npy_cfloat, z, IMAG) + return ((float *) &z)[1]; } static inline void npy_csetimagf(npy_cfloat *z, const float i) { - NPY_COMPLEX_SET(float, npy_cfloat, z, i, IMAG) + ((float *) z)[1] = i; } static inline npy_longdouble npy_creall(const npy_clongdouble z) { - NPY_COMPLEX_GET(longdouble_t, npy_clongdouble, z, REAL) + return ((longdouble_t *) &z)[0]; } static inline void npy_csetreall(npy_clongdouble *z, const longdouble_t r) { - NPY_COMPLEX_SET(longdouble_t, npy_clongdouble, z, r, REAL) + ((longdouble_t *) z)[0] = r; } static inline npy_longdouble npy_cimagl(const npy_clongdouble z) { - NPY_COMPLEX_GET(longdouble_t, npy_clongdouble, z, IMAG) + return ((longdouble_t *) &z)[1]; } static inline void npy_csetimagl(npy_clongdouble *z, const longdouble_t i) { - NPY_COMPLEX_SET(longdouble_t, npy_clongdouble, z, i, IMAG) + ((longdouble_t *) z)[1] = i; } #define NPY_CSETREAL(z, r) npy_csetreal(z, r) @@ -446,12 +427,6 @@ static inline void npy_csetimagl(npy_clongdouble *z, const longdouble_t i) #define NPY_CSETREALL(z, r) npy_csetreall(z, r) #define NPY_CSETIMAGL(z, i) npy_csetimagl(z, i) -#undef REAL -#undef IMAG -#undef CREATE_UNION -#undef NPY_COMPLEX_GET -#undef NPY_COMPLEX_SET - static inline npy_cdouble npy_cpack(double x, double y) { npy_cdouble z; diff --git a/numpy/core/src/umath/clip.cpp b/numpy/core/src/umath/clip.cpp index 2eee8f13a7dd..3f6e0434d5c3 100644 --- a/numpy/core/src/umath/clip.cpp +++ b/numpy/core/src/umath/clip.cpp @@ -59,6 +59,7 @@ _NPY_MAX(T a, T b, npy::floating_point_tag const &) (npy_creal##suffix(p) < npy_creal##suffix(q)))) #define PyArray_CGT(p,q,suffix) (((npy_creal##suffix(p)==npy_creal##suffix(q)) ? (npy_cimag##suffix(p) > npy_cimag##suffix(q)) : \ (npy_creal##suffix(p) > npy_creal##suffix(q)))) + npy_cdouble _NPY_MIN(npy_cdouble a, npy_cdouble b, npy::complex_tag const &) { diff --git a/numpy/core/src/umath/scalarmath.c.src b/numpy/core/src/umath/scalarmath.c.src index b8dabc1b23d1..743ecc128659 100644 --- a/numpy/core/src/umath/scalarmath.c.src +++ b/numpy/core/src/umath/scalarmath.c.src @@ -1777,10 +1777,6 @@ static PyObject * /**begin repeat * - * #NAME = BYTE, UBYTE, SHORT, USHORT, INT, - * UINT, LONG, ULONG, LONGLONG, ULONGLONG, - * HALF, FLOAT, DOUBLE, LONGDOUBLE, - * CFLOAT, CDOUBLE, CLONGDOUBLE# * #name = byte, ubyte, short, ushort, int, uint, * long, ulong, longlong, ulonglong, * half, float, double, longdouble,