123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450 |
- /*
- * src/c_qd.cc
- *
- * This work was supported by the Director, Office of Science, Division
- * of Mathematical, Information, and Computational Sciences of the
- * U.S. Department of Energy under contract number DE-AC03-76SF00098.
- *
- * Copyright (c) 2000-2001
- *
- * Contains C wrapper function for quad-double precision arithmetic.
- * This can be used from fortran code.
- */
- #include <cstring>
- #include "config.h"
- #include <qd/qd_real.h>
- #include <qd/c_qd.h>
- #define TO_DOUBLE_PTR(a, ptr) ptr[0] = a.x[0]; ptr[1] = a.x[1]; \
- ptr[2] = a.x[2]; ptr[3] = a.x[3];
- extern "C" {
- /* add */
- void c_qd_add(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = qd_real(a) + qd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_add_qd_dd(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = qd_real(a) + dd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_add_dd_qd(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = dd_real(a) + qd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_add_qd_d(const double *a, double b, double *c) {
- qd_real cc;
- cc = qd_real(a) + b;
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_add_d_qd(double a, const double *b, double *c) {
- qd_real cc;
- cc = a + qd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- /* sub */
- void c_qd_sub(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = qd_real(a) - qd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_sub_qd_dd(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = qd_real(a) - dd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_sub_dd_qd(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = dd_real(a) - qd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_sub_qd_d(const double *a, double b, double *c) {
- qd_real cc;
- cc = qd_real(a) - b;
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_sub_d_qd(double a, const double *b, double *c) {
- qd_real cc;
- cc = a - qd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- /* mul */
- void c_qd_mul(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = qd_real(a) * qd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_mul_qd_dd(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = qd_real(a) * dd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_mul_dd_qd(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = dd_real(a) * qd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_mul_qd_d(const double *a, double b, double *c) {
- qd_real cc;
- cc = qd_real(a) * b;
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_mul_d_qd(double a, const double *b, double *c) {
- qd_real cc;
- cc = a * qd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- /* div */
- void c_qd_div(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = qd_real(a) / qd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_div_qd_dd(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = qd_real(a) / dd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_div_dd_qd(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = dd_real(a) / qd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_div_qd_d(const double *a, double b, double *c) {
- qd_real cc;
- cc = qd_real(a) / b;
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_div_d_qd(double a, const double *b, double *c) {
- qd_real cc;
- cc = a / qd_real(b);
- TO_DOUBLE_PTR(cc, c);
- }
- /* selfadd */
- void c_qd_selfadd(const double *a, double *b) {
- qd_real bb(b);
- bb += qd_real(a);
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_selfadd_dd(const double *a, double *b) {
- qd_real bb(b);
- bb += dd_real(a);
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_selfadd_d(double a, double *b) {
- qd_real bb(b);
- bb += a;
- TO_DOUBLE_PTR(bb, b);
- }
- /* selfsub */
- void c_qd_selfsub(const double *a, double *b) {
- qd_real bb(b);
- bb -= qd_real(a);
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_selfsub_dd(const double *a, double *b) {
- qd_real bb(b);
- bb -= dd_real(a);
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_selfsub_d(double a, double *b) {
- qd_real bb(b);
- bb -= a;
- TO_DOUBLE_PTR(bb, b);
- }
- /* selfmul */
- void c_qd_selfmul(const double *a, double *b) {
- qd_real bb(b);
- bb *= qd_real(a);
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_selfmul_dd(const double *a, double *b) {
- qd_real bb(b);
- bb *= dd_real(a);
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_selfmul_d(double a, double *b) {
- qd_real bb(b);
- bb *= a;
- TO_DOUBLE_PTR(bb, b);
- }
- /* selfdiv */
- void c_qd_selfdiv(const double *a, double *b) {
- qd_real bb(b);
- bb /= qd_real(a);
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_selfdiv_dd(const double *a, double *b) {
- qd_real bb(b);
- bb /= dd_real(a);
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_selfdiv_d(double a, double *b) {
- qd_real bb(b);
- bb /= a;
- TO_DOUBLE_PTR(bb, b);
- }
- /* copy */
- void c_qd_copy(const double *a, double *b) {
- b[0] = a[0];
- b[1] = a[1];
- b[2] = a[2];
- b[3] = a[3];
- }
- void c_qd_copy_dd(const double *a, double *b) {
- b[0] = a[0];
- b[1] = a[1];
- b[2] = 0.0;
- b[3] = 0.0;
- }
- void c_qd_copy_d(double a, double *b) {
- b[0] = a;
- b[1] = 0.0;
- b[2] = 0.0;
- b[3] = 0.0;
- }
- void c_qd_sqrt(const double *a, double *b) {
- qd_real bb;
- bb = sqrt(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_sqr(const double *a, double *b) {
- qd_real bb;
- bb = sqr(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_abs(const double *a, double *b) {
- qd_real bb;
- bb = abs(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_npwr(const double *a, int n, double *b) {
- qd_real bb;
- bb = npwr(qd_real(a), n);
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_nroot(const double *a, int n, double *b) {
- qd_real bb;
- bb = nroot(qd_real(a), n);
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_nint(const double *a, double *b) {
- qd_real bb;
- bb = nint(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_aint(const double *a, double *b) {
- qd_real bb;
- bb = aint(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_floor(const double *a, double *b) {
- qd_real bb;
- bb = floor(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_ceil(const double *a, double *b) {
- qd_real bb;
- bb = ceil(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_log(const double *a, double *b) {
- qd_real bb;
- bb = log(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_log10(const double *a, double *b) {
- qd_real bb;
- bb = log10(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_exp(const double *a, double *b) {
- qd_real bb;
- bb = exp(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_sin(const double *a, double *b) {
- qd_real bb;
- bb = sin(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_cos(const double *a, double *b) {
- qd_real bb;
- bb = cos(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_tan(const double *a, double *b) {
- qd_real bb;
- bb = tan(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_asin(const double *a, double *b) {
- qd_real bb;
- bb = asin(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_acos(const double *a, double *b) {
- qd_real bb;
- bb = acos(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_atan(const double *a, double *b) {
- qd_real bb;
- bb = atan(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_atan2(const double *a, const double *b, double *c) {
- qd_real cc;
- cc = atan2(qd_real(a), qd_real(b));
- TO_DOUBLE_PTR(cc, c);
- }
- void c_qd_sinh(const double *a, double *b) {
- qd_real bb;
- bb = sinh(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_cosh(const double *a, double *b) {
- qd_real bb;
- bb = cosh(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_tanh(const double *a, double *b) {
- qd_real bb;
- bb = tanh(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_asinh(const double *a, double *b) {
- qd_real bb;
- bb = asinh(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_acosh(const double *a, double *b) {
- qd_real bb;
- bb = acosh(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_atanh(const double *a, double *b) {
- qd_real bb;
- bb = atanh(qd_real(a));
- TO_DOUBLE_PTR(bb, b);
- }
- void c_qd_sincos(const double *a, double *s, double *c) {
- qd_real ss, cc;
- sincos(qd_real(a), ss, cc);
- TO_DOUBLE_PTR(cc, c);
- TO_DOUBLE_PTR(ss, s);
- }
- void c_qd_sincosh(const double *a, double *s, double *c) {
- qd_real ss, cc;
- sincosh(qd_real(a), ss, cc);
- TO_DOUBLE_PTR(cc, c);
- TO_DOUBLE_PTR(ss, s);
- }
- void c_qd_read(const char *s, double *a) {
- qd_real aa(s);
- TO_DOUBLE_PTR(aa, a);
- }
- void c_qd_swrite(const double *a, int precision, char *s, int len) {
- qd_real(a).write(s, len, precision);
- }
- void c_qd_write(const double *a) {
- std::cout << qd_real(a).to_string(qd_real::_ndigits) << std::endl;
- }
- void c_qd_neg(const double *a, double *b) {
- b[0] = -a[0];
- b[1] = -a[1];
- b[2] = -a[2];
- b[3] = -a[3];
- }
- void c_qd_rand(double *a) {
- qd_real aa;
- aa = qdrand();
- TO_DOUBLE_PTR(aa, a);
- }
- void c_qd_comp(const double *a, const double *b, int *result) {
- qd_real aa(a), bb(b);
- if (aa < bb)
- *result = -1;
- else if (aa > bb)
- *result = 1;
- else
- *result = 0;
- }
- void c_qd_comp_qd_d(const double *a, double b, int *result) {
- qd_real aa(a);
- if (aa < b)
- *result = -1;
- else if (aa > b)
- *result = 1;
- else
- *result = 0;
- }
- void c_qd_comp_d_qd(double a, const double *b, int *result) {
- qd_real bb(b);
- if (a < bb)
- *result = -1;
- else if (a > bb)
- *result = 1;
- else
- *result = 0;
- }
- void c_qd_pi(double *a) {
- TO_DOUBLE_PTR(qd_real::_pi, a);
- }
- }
|