Math-Cephes-0.5306/0000755000175000017500000000000014757250372013605 5ustar shlomifshlomifMath-Cephes-0.5306/Makefile.PL0000644000175000017500000002123614757022177015563 0ustar shlomifshlomif# See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. use strict; use ExtUtils::MakeMaker; use Config; use File::Spec::Functions qw(catfile catdir); use Cwd; my $cwd = getcwd; my $libmd = catdir $cwd, 'libmd'; my $arch = $Config{archname}; my $is_win32 = ($arch =~ /MSWin32/i && $Config{cc} eq 'cl'); my $is_387 = ($arch =~ /^i\d+-linux/i); my $is_s390 = ($arch =~ /^s390x?-/i); my $is_m68k = ($arch =~ /^m68k-/i); my $is_ppc = ($arch =~ /^powerpc(64)?-/i); my $is_parisc = ($arch =~ /^hppa-/i); my $is_sol = ($arch =~ /sun4-solaris|sparc/i); my $is_dar = ($arch =~ /darwin/i); my $is_cyg = ($arch =~ /cygwin/i || ($arch =~ /MSWin32/i && !$is_win32)); my $is_vms = ($arch =~ /vms/i); my $dmake = ($Config{make} eq 'dmake'); ###################################### # for dmake, fool WriteMakefile into thinking there's a libmd lib if ($dmake) { my $lib = 'libmd' . $Config{lib_ext}; my $dummy = catfile $libmd, $lib; open(my $dummy_fh, '>',$dummy) or die "Cannot create $dummy: $!"; close $dummy_fh; } ###################################### my @clean = qw(libmd/setprec.c libmd/mconf.h libmd/sqrt.c); my %opts = ( NAME => 'Math::Cephes', MYEXTLIB => "$libmd/libmd\$(LIB_EXT)", VERSION_FROM => 'lib/Math/Cephes.pm', OBJECT => 'Cephes_wrap.o arrays.o', INC => "-I$libmd", EXE_FILES => [ 'pmath' ], META_MERGE => { resources => { repository => 'https://github.com/shlomif/Math-Cephes', }, }, dist => { SUFFIX => 'gz', COMPRESS => 'gzip -9f', }, clean => { FILES => "@clean"}, ); my $eu_version = $ExtUtils::MakeMaker::VERSION; if ($eu_version >= 5.43) { $opts{ABSTRACT} = 'Perl interface to the math cephes library'; # $opts{AUTHOR} = 'Randy Kobes '; $opts{AUTHOR} = 'Shlomi Fish '; $opts{CAPI} = 'TRUE' if $arch =~ /-object\b/i; } if ($eu_version >= 6.31) { $opts{LICENSE} = 'perl'; } if ($eu_version >= 6.48) { $opts{MIN_PERL_VERSION} = '5.008'; } my $mconf = catfile $libmd, 'mconf.h'; my %defs = (HAVE_LONG_DOUBLE => 'd_longdbl', SIZEOF_INT => 'intsize', RETSIGTYPE => 'd_voidsig', HAVE_MALLOC_H => 'i_malloc', HAVE_STRING_H => 'i_string', VOLATILE => 'd_volatile', ); my $vals = {RETSIGTYPE => {define => 'void', undef => 'int'}, VOLATILE => {define => 'volatile', undef => ''}, }; if ($is_win32 or $is_387 or $is_cyg) { $defs{IBMPC} = 1; } elsif ($is_sol or $is_s390 or $is_m68k or $is_ppc or $is_parisc) { $defs{WORDS_BIGENDIAN} = 1; $defs{FLOAT_WORDS_BIGENDIAN} = 1; $defs{UNK} = 1; } elsif ($is_dar) { require POSIX; my $machine = (POSIX::uname())[4]; if ($machine eq 'i386' or $machine eq 'x86_64') { $defs{IBMPC} = 1; } else { $defs{WORDS_BIGENDIAN} = 1; $defs{FLOAT_WORDS_BIGENDIAN} = 1; $defs{MIEEE} = 1; } } elsif ($is_vms) { $defs{DEC} = 1; } else { $defs{UNK} = 1; } my $match = join '|', keys %defs; open(my $mconf_fh, '>', $mconf) or die "Cannot open $mconf: $!"; while (my $line = ) { if ($line =~ /\#define\s+($match)/) { my $def = $1; print {$mconf_fh} fix_mconf($def, $defs{$def}); } elsif ($line =~ /^\#define XPD/) { my $lds = $Config{longdblsize}; my $xpd = ($is_387 and $lds and $lds == 12) ? '0,' : ''; print {$mconf_fh} qq{\#define XPD $xpd\n}; } else { print {$mconf_fh} $line; } } close $mconf_fh; WriteMakefile(%opts); my $message; if ($is_sol or $is_dar or $is_win32 or $is_387) { $message = <<"END"; A file libmd/mconf.h, which contains machine-dependent definitions, has been used which is known to work with some versions of $arch. If there are problems with the tests, some manual editing of this file may be needed. END } else { $message = <<'END'; The file libmd/mconf.h, which contains machine-dependent definitions, may require some manual editing for your platform. END } print $message; sub fix_mconf { my ($what, $key) = @_; my $lookup = $Config{$key} ? $Config{$key} : ( ($key == 1) ? 'define' : 'undef' ); my $string; my $val = $vals->{$what}->{$lookup}; if ($lookup eq 'define') { $string = defined $val ? qq{\#define $what $val\n} : qq{\#define $what 1\n}; } elsif ($lookup eq 'undef') { $string = defined $val ? qq{\#define $what $val\n} : qq{\#ifdef $what\n\#undef $what\n\#endif\n}; } else { $string = qq{\#define $what $lookup\n}; } return $string; } sub MY::postamble { my $postamble = ''; if ($is_win32 && Win32::IsWin95()) { if ($Config{'make'} =~ /dmake/i) { # dmake-specific $postamble .= <<"EOT"; \$(MYEXTLIB): $libmd/Makefile \@[ cd $libmd \$(MAKE) static cd .. ] EOT } elsif ($Config{'make'} =~ /nmake/i) { # $postamble .= <<"EOT"; \$(MYEXTLIB): $libmd/Makefile cd $libmd \$(MAKE) static cd .. EOT } } elsif ($^O ne 'VMS') { $postamble .= <<"EOT"; \$(MYEXTLIB): $libmd/Makefile cd $libmd && \$(MAKE) static EOT } else { $postamble .= <<"EOT"; \$(MYEXTLIB) : ${libmd}descrip.mms set def $libmd $(MMS) static set def [-] EOT } return $postamble; } __DATA__ /* Cephes Math Library Release 2.3: June, 1995 Copyright 1984, 1987, 1989, 1995 by Stephen L. Moshier */ /* Define if the `long double' type works. */ #define HAVE_LONG_DOUBLE 1 /* Define as the return type of signal handlers (int or void). */ #define RETSIGTYPE void /* Define if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Define if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel and VAX). */ /* #define WORDS_BIGENDIAN */ /* Define if floating point words are bigendian. */ /* #define FLOAT_WORDS_BIGENDIAN */ /* The number of bytes in a int. */ #define SIZEOF_INT 4 /* Define if you have the header file. */ #define HAVE_MALLOC_H 1 /* Define if you have the header file. */ #define HAVE_STRING_H 1 /* Name of package */ #define PACKAGE "cephes" /* Version number of package */ #define VERSION_CEPHES "2.7" /* Constant definitions for math error conditions */ #define DOMAIN 1 /* argument domain error */ #define SING 2 /* argument singularity */ #define OVERFLOW 3 /* overflow range error */ #define UNDERFLOW 4 /* underflow range error */ #define TLOSS 5 /* total loss of precision */ #define PLOSS 6 /* partial loss of precision */ #define EDOM 33 #define ERANGE 34 /* Complex numeral. */ typedef struct { double r; double i; } cmplx; #ifdef HAVE_LONG_DOUBLE /* Long double complex numeral. */ typedef struct { long double r; long double i; } cmplxl; #endif /* Type of computer arithmetic */ /* PDP-11, Pro350, VAX: */ /* #define DEC 1 */ /* Intel IEEE, low order words come first: */ /* #define IBMPC 1 */ /* Motorola IEEE, high order words come first * (Sun 680x0 workstation): */ /* #define MIEEE 1 */ /* UNKnown arithmetic, invokes coefficients given in * normal decimal format. Beware of range boundary * problems (MACHEP, MAXLOG, etc. in const.c) and * roundoff problems in pow.c: * (Sun SPARCstation) */ /* #define UNK 1 */ /* If you define UNK, then be sure to set BIGENDIAN properly. */ #ifdef FLOAT_WORDS_BIGENDIAN #define BIGENDIAN 1 #else #define BIGENDIAN 0 #endif /* Define this `volatile' if your compiler thinks * that floating point arithmetic obeys the associative * and distributive laws. It will defeat some optimizations * (but probably not enough of them). * */ /* #define VOLATILE volatile */ /* For 12-byte long doubles on an i386, pad a 16-bit short 0 * to the end of real constants initialized by integer arrays. * * #define XPD 0, * * Otherwise, the type is 10 bytes long and XPD should be * defined blank (e.g., Microsoft C). * * #define XPD */ #define XPD 0, /* Define to support tiny denormal numbers, else undefine. */ #define DENORMAL 1 /* Define to ask for infinity support, else undefine. */ #define INFINITIES 1 /* Define to ask for support of numbers that are Not-a-Number, else undefine. This may automatically define INFINITIES in some files. */ #define NANS 1 /* Define to distinguish between -0.0 and +0.0. */ #define MINUSZERO 1 /* Define 1 for ANSI C atan2() function See atan.c and clog.c. */ #define ANSIC 1 /* Get ANSI function prototypes, if you want them. */ #ifdef __STDC__ #define ANSIPROT /* #include "protos.h" */ int mtherr(char *, int); #else int mtherr(); #endif /* Variable for error reporting. See mtherr.c. */ extern int merror; Math-Cephes-0.5306/META.yml0000644000175000017500000000116614757250372015062 0ustar shlomifshlomif--- abstract: 'Perl interface to the math cephes library' author: - 'Shlomi Fish ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Math-Cephes no_index: directory: - t - inc requires: perl: '5.008' resources: repository: https://github.com/shlomif/Math-Cephes version: '0.5306' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Math-Cephes-0.5306/Cephes.i0000644000175000017500000002346714757021403015171 0ustar shlomifshlomif%include typemaps.i %{ typedef struct { double n; double d; } fract; typedef struct { double r; double i; } cmplx; typedef double * arr1d; typedef int * arr1i; %} %typemap(in) arr1d { $1 = (double *) pack1D($input,'d'); } %typemap(in) arr1i { $1 = (int *) pack1D($input,'i'); } %typemap(argout) arr1d { unpack1D((SV*)$input, (void *)$1, 'd', 0); } %typemap(argout) arr1i { unpack1D((SV*)$input, (void *)$1, 'i', 0); } typedef struct { double r; double i; %extend { cmplx(double r=0, double i=0) { cmplx *c; c = (cmplx *) malloc(sizeof(cmplx)); c->r = r; c->i = i; return c; } ~cmplx() { free(self); } } } cmplx; typedef struct { double n; double d; %extend { fract(double n=0, double d=1) { fract *f; f = (fract *) malloc(sizeof(fract)); f->n = n; f->d = d; return f; } ~fract() { free(self); } } } fract; extern double MACHEP; extern double MAXLOG; extern double MINLOG; extern double MAXNUM; extern double PI; extern double PIO2; extern double PIO4; extern double SQRT2; extern double SQRTH; extern double LOG2E; extern double SQ2OPI; extern double LOGE2; extern double LOGSQ2; extern double THPIO4; extern double TWOOPI; extern double md_acosh ( double x ); extern int airy ( double x, double *OUTPUT, double *OUTPUT, double *OUTPUT, double *OUTPUT ); extern double md_asin ( double x ); extern double md_acos ( double x ); extern double md_asinh ( double x ); extern double md_atan ( double x ); extern double md_atan2 ( double y, double x ); extern double md_atanh ( double x ); extern double bdtrc ( int k, int n, double p ); extern double bdtr ( int k, int n, double p ); extern double bdtri ( int k, int n, double y ); extern double beta ( double a, double b ); extern double lbeta ( double a, double b ); extern double btdtr ( double a, double b, double x ); extern double md_cbrt ( double x ); extern double chbevl ( double x, void *P, int n ); extern double chdtrc ( double df, double x ); extern double chdtr ( double df, double x ); extern double chdtri ( double df, double y ); extern void md_clog ( cmplx *z, cmplx *w ); extern void md_cexp ( cmplx *z, cmplx *w ); extern void md_csin ( cmplx *z, cmplx *w ); extern void md_ccos ( cmplx *z, cmplx *w ); extern void md_ctan ( cmplx *z, cmplx *w ); extern void ccot ( cmplx *z, cmplx *w ); extern void md_casin ( cmplx *z, cmplx *w ); extern void md_cacos ( cmplx *z, cmplx *w ); extern void md_catan ( cmplx *z, cmplx *w ); extern void md_csinh ( cmplx *z, cmplx *w ); extern void md_casinh ( cmplx *z, cmplx *w ); extern void md_ccosh ( cmplx *z, cmplx *w ); extern void md_cacosh ( cmplx *z, cmplx *w ); extern void md_ctanh ( cmplx *z, cmplx *w ); extern void md_catanh ( cmplx *z, cmplx *w ); extern void md_cpow ( cmplx *a, cmplx *z, cmplx *w ); extern void radd ( fract *a, fract *b, fract *c ); extern void rsub ( fract *a, fract *b, fract *c ); extern void rmul ( fract *a, fract *b, fract *c ); extern void rdiv ( fract *a, fract *b, fract *c ); extern double euclid ( double *INOUT, double *INOUT); extern void cadd ( cmplx *a, cmplx *b, cmplx *c ); extern void csub ( cmplx *a, cmplx *b, cmplx *c ); extern void cmul ( cmplx *a, cmplx *b, cmplx *c ); extern void cdiv ( cmplx *a, cmplx *b, cmplx *c ); extern void cmov ( void *a, void *b ); extern void cneg ( cmplx *a ); extern double md_cabs ( cmplx *z ); extern void md_csqrt ( cmplx *z, cmplx *w ); extern double md_hypot ( double x, double y ); extern double md_cosh ( double x ); extern double dawsn ( double xx ); extern double ellie ( double phi, double m ); extern double ellik ( double phi, double m ); extern double ellpe ( double x ); extern int ellpj ( double u, double m, double *OUTPUT, double *OUTPUT, double *OUTPUT, double *OUTPUT ); extern double ellpk ( double x ); extern double md_exp ( double x ); extern double md_exp10 ( double x ); /* extern double exp1m ( double x ); */ extern double md_exp2 ( double x ); extern double md_expn ( int n, double x ); extern double ei ( double x ); extern double md_fabs ( double x ); extern double fac ( int i ); extern double fdtrc ( int ia, int ib, double x ); extern double fdtr ( int ia, int ib, double x ); extern double fdtri ( int ia, int ib, double y ); extern double md_ceil ( double x ); extern double md_floor ( double x ); extern double md_frexp ( double x, int *OUTPUT); /* extern double md_frexp ( double x, int *pw2 ); */ extern double md_ldexp ( double x, int pw2 ); /* extern int signbit ( double x ); */ /* extern int isnan ( double x ); */ /* extern int isfinite ( double x ); */ extern int fresnl ( double xxa, double *OUTPUT, double *OUTPUT); extern double md_gamma ( double x ); extern double lgam ( double x ); extern double gdtr ( double a, double b, double x ); extern double gdtrc ( double a, double b, double x ); extern double hyp2f1 ( double a, double b, double c, double x ); extern double hyperg ( double a, double b, double x ); extern double hyp2f0 ( double a, double b, double x, int type, double *OUTPUT ); extern double i0 ( double x ); extern double i0e ( double x ); extern double i1 ( double x ); extern double i1e ( double x ); extern double igamc ( double a, double x ); extern double igam ( double a, double x ); extern double igami ( double a, double md_y0 ); extern double incbet ( double aa, double bb, double xx ); extern double incbi ( double aa, double bb, double yy0 ); extern double iv ( double v, double x ); extern double md_j0 ( double x ); extern double md_y0 ( double x ); extern double md_j1 ( double x ); extern double md_y1 ( double x ); extern double md_jn ( int n, double x ); extern double jv ( double n, double x ); extern double k0 ( double x ); extern double k0e ( double x ); extern double k1 ( double x ); extern double k1e ( double x ); extern double kn ( int nn, double x ); extern double md_log ( double x ); extern double md_log10 ( double x ); extern double md_log2 ( double x ); extern long lrand ( void ); extern long lsqrt ( long x ); extern int mtherr ( char *name, int code ); extern double polevl ( double x, void *P, int N ); extern double p1evl ( double x, void *P, int N ); extern double nbdtrc ( int k, int n, double p ); extern double nbdtr ( int k, int n, double p ); extern double nbdtri ( int k, int n, double p ); extern double ndtr ( double a ); extern double md_erfc ( double a ); extern double md_erf ( double x ); extern double ndtri ( double md_y0 ); extern double pdtrc ( int k, double m ); extern double pdtr ( int k, double m ); extern double pdtri ( int k, double y ); extern double md_pow ( double x, double y ); extern double md_powi ( double x, int nn ); extern double psi ( double x ); extern double rgamma ( double x ); extern double md_round ( double x ); extern int shichi ( double x, double *OUTPUT, double *OUTPUT ); extern int sici ( double x, double *OUTPUT, double *OUTPUT ); extern double md_sin ( double x ); extern double md_cos ( double x ); extern double radian ( double d, double m, double s ); /* extern int sincos ( double x, double *OUTPUT, double *OUTPUT, int flg ); */ extern double md_sindg ( double x ); extern double cosdg ( double x ); extern double md_sinh ( double x ); extern double spence ( double x ); extern double sqrt ( double x ); extern double stdtr ( int k, double t ); extern double stdtri ( int k, double p ); extern double onef2 ( double a, double b, double c, double x, double *OUTPUT ); extern double threef0 ( double a, double b, double c, double x, double *OUTPUT ); extern double struve ( double v, double x ); extern double md_tan ( double x ); extern double cot ( double x ); extern double tandg ( double x ); extern double cotdg ( double x ); extern double md_tanh ( double x ); extern double md_log1p ( double x ); extern double expm1 ( double x ); extern double cosm1 ( double x ); extern double md_yn ( int n, double x ); extern double yv ( double n, double x ); extern double zeta ( double x, double q ); extern double zetac ( double x ); extern int drand ( double *OUTPUT ); extern double plancki(double w, double T); extern void polini( int maxdeg ); extern void polmul ( arr1d A, int na, arr1d B, int nb, arr1d C ); extern int poldiv ( arr1d A, int na, arr1d B, int nb, arr1d C); extern void poladd ( arr1d A, int na, arr1d B, int nb, arr1d C ); extern void polsub ( arr1d A, int na, arr1d B, int nb, arr1d C ); extern void polsbt ( arr1d A, int na, arr1d B, int nb, arr1d C ); extern double poleva (arr1d A, int na, double x); extern void polatn(arr1d A, arr1d B, arr1d C, int n); extern void polsqt(arr1d A, arr1d B, int n); extern void polsin(arr1d A, arr1d B, int n); extern void polcos(arr1d A, arr1d B, int n); extern int polrt_wrap(arr1d xcof, arr1d cof, int m, arr1d r, arr1d i); extern int cpmul_wrap(arr1d ar, arr1d ai, int da, arr1d br, arr1d bi, int db, arr1d cr, arr1d ci, int *INOUT); extern void fpolini( int maxdeg ); extern void fpolmul_wrap ( arr1d A, arr1d Ad, int na, arr1d Bn, arr1d Bd, int nb, arr1d Cn, arr1d Cd, int nc ); extern int fpoldiv_wrap ( arr1d A, arr1d Ad, int na, arr1d Bn, arr1d Bd, int nb, arr1d Cn, arr1d Cd, int nc); extern void fpoladd_wrap ( arr1d A, arr1d Ad, int na, arr1d Bn, arr1d Bd, int nb, arr1d Cn, arr1d Cd, int nc ); extern void fpolsub_wrap ( arr1d A, arr1d Ad, int na, arr1d Bn, arr1d Bd, int nb, arr1d Cn, arr1d Cd, int nc ); extern void fpolsbt_wrap ( arr1d A, arr1d Ad, int na, arr1d Bn, arr1d Bd, int nb, arr1d Cn, arr1d Cd, int nc ); extern void fpoleva_wrap( arr1d An, arr1d Ad, int na, fract *x, fract *s); extern void bernum_wrap(arr1d num, arr1d den); extern double simpsn_wrap(arr1d f, int n, double h); extern int minv(arr1d A, arr1d X, int n, arr1d B, arr1i IPS); extern void mtransp(int n, arr1d A, arr1d X); extern void eigens(arr1d A, arr1d EV, arr1d E, int n); extern int simq(arr1d A, arr1d B, arr1d X, int n, int flag, arr1i IPS); extern double polylog(int n, double x); extern double arcdot(arr1d p, arr1d q); extern double expx2(double x, int sign); Math-Cephes-0.5306/t/0000755000175000017500000000000014757250372014050 5ustar shlomifshlomifMath-Cephes-0.5306/t/hypers.t0000644000175000017500000000170014757021403015534 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..7\n"; } END {print "not ok 1\n" unless $loaded;} use Math::Cephes qw(:hypers :explog); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $x = 3; my $y = (exp($x)+exp(-$x))/2; ok(cosh($x), $y); ok( acosh($y), $x); $y = (exp($x)-exp(-$x))/2; ok( sinh($x), $y); ok( asinh($y), $x); $y = 1 - 2/(exp(2*$x)+1); ok( tanh($x), $y); ok( atanh($y), $x); Math-Cephes-0.5306/t/elliptics.t0000644000175000017500000000223514757021403016216 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..10\n";} END {print "not ok 1\n" unless $loaded;} use Math::Cephes qw(:elliptics :constants :utils :trigs); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $x = 0.3; ok( ellpk(1-$x*$x), 1.608048620); ok( ellik(asin(0.2), $x*$x), .2014795901); ok( ellpe(1-$x*$x), 1.534833465); ok( ellie(asin(0.2), $x*$x), .2012363833); my $phi = $PIO4; my $m = 0.3; my $u = ellik($phi, $m); my ($flag, $sn, $cn, $dn, $phi_out) = ellpj($u, $m); ok( $flag, 0); ok( $phi, $phi_out); ok( $sn, sin($phi_out)); ok( $cn, cos($phi_out)); ok( $dn, sqrt(1-$m*sin($phi_out)*sin($phi_out))); Math-Cephes-0.5306/t/explog.t0000644000175000017500000000216014757021403015521 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..16\n"; } END {print "not ok 1\n" unless $loaded;} use Math::Cephes qw(:explog :utils :constants); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $e = exp(1); ok( log(pow($e, $e)), $e); ok( log($e*$e), 2); ok( 1/log(2), $LOG2E); ok( exp(-1), 1/$e); ok( exp($LOGE2), 2); ok( log10(10000), 4); ok( log10(sqrt(10)), 0.5); ok( exp2(-1/2), $SQRTH); ok( exp2(8), 256); ok( log2($SQRT2), 0.5); ok( log2(256), 8); ok( log1p(0.5), log(1.5)); ok( expm1(0.5), exp(0.5)-1); ok( expxx(0.5), exp(0.25)); ok( expxx(2, -1), exp(-4)); Math-Cephes-0.5306/t/new_cmplx.t0000644000175000017500000000063114757021403016220 0ustar shlomifshlomif#!/usr/bin/perl use strict; use warnings; use lib './t/lib'; use Utils qw(is_between); use Test::More tests => 1; use Math::Cephes qw(:cmplx); use Math::Cephes::Complex; ######################### End of black magic. { my $z = new_cmplx(2,0); my $w = new_cmplx(); cexp($z, $w); my $want = exp(2); # TEST is_between ($w->{r}, $want - 1e-5, $want + 1e-5, "Testing new_complx"); } Math-Cephes-0.5306/t/mat.t0000644000175000017500000000540414757021403015010 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..74\n";} END {print "not ok 1\n" unless $loaded;} use Math::Cephes::Matrix qw(mat); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $M = Math::Cephes::Matrix->new([ [1, 2, -1], [2, -3, 1], [1, 0, 3]]); my $B = [2, -1, 10]; my $X = $M->simq($B); ok( $X->[0], 1); ok( $X->[1], 2); ok( $X->[2], 3); my $C = Math::Cephes::Matrix->new([ [1, 2, 4], [2, 9, 2], [6, 2, 7]]); my $I = $C->inv(); my $T = $I->mul($C)->coef; ok( $T->[0]->[0], 1); ok( $T->[1]->[1], 1); ok( $T->[2]->[2], 1); ok( $T->[0]->[1], 0); ok( $T->[1]->[0], 0); ok( $T->[2]->[0], 0); my $V = $M->mul($X); ok( $V->[0], $B->[0]); ok( $V->[1], $B->[1]); ok( $V->[2], $B->[2]); my $D = $M->add($C)->coef; ok( $D->[0]->[0], 2); ok( $D->[1]->[1], 6); ok( $D->[2]->[2], 10); ok( $D->[0]->[1], 4); ok( $D->[1]->[0], 4); ok( $D->[2]->[0], 7); $D = $M->sub($C)->coef; ok( $D->[0]->[0], 0); ok( $D->[1]->[1], -12); ok( $D->[2]->[2], -4); ok( $D->[0]->[1], 0); ok( $D->[1]->[0], 0); ok( $D->[2]->[0], -5); my $H = $C->transp()->coef; ok( $H->[0]->[0], 1); ok( $H->[1]->[1], 9); ok( $H->[2]->[2], 7); ok( $H->[0]->[1], 2); ok( $H->[1]->[0], 2); ok( $H->[2]->[0], 4); my $R = $M->div($C); my $Q = $R->mul($C)->coef; my $Mc = $M->coef; for (my $i=0; $i<3; $i++) { for (my $j=0; $j<3; $j++) { ok($Q->[$i]->[$j], $Mc->[$i]->[$j]); } } $R = $M->mul($C)->coef; ok( $R->[0]->[0], -1); ok( $R->[1]->[1], -21); ok( $R->[2]->[2], 25); ok( $R->[0]->[1], 18); ok( $R->[1]->[0], 2); ok( $R->[2]->[0], 19); $C->clr(); $R = $C->coef; ok( $R->[0]->[0], 0); ok( $R->[2]->[2], 0); ok( $R->[1]->[0], 0); ok( $R->[2]->[0], 0); $C->clr(3); $R = $C->coef; ok( $R->[0]->[0], 3); ok( $R->[2]->[2], 3); ok( $R->[1]->[0], 3); ok( $R->[2]->[0], 3); my $S = Math::Cephes::Matrix->new([ [1, 2, 3], [2, 2, 3], [3, 3, 4]]); my ($E, $EV1) = $S->eigens(); my $EV = $EV1->coef; for (my $i=0; $i<3; $i++) { my $v = []; for (my $j=0; $j<3; $j++) { $v->[$j] = $EV->[$i]->[$j]; } my $sv = $S->mul($v); for (my $j=0; $j<3; $j++) { ok($sv->[$j], $E->[$i]*$v->[$j]); } } my $Z = $M->new()->coef; for (my $i=0; $i<3; $i++) { for (my $j=0; $j<3; $j++) { ok($Z->[$i]->[$j], $Mc->[$i]->[$j]); } } $Z->[0]->[0] = 5; ok($Mc->[0]->[0], 1); ok($Z->[0]->[0], 5); Math-Cephes-0.5306/t/style-trailing-space.t0000644000175000017500000000073514757021403020271 0ustar shlomifshlomif#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::TrailingSpace"; if ($@) { plan skip_all => "Test::TrailingSpace required for trailing space test."; } else { plan tests => 1; } my $finder = Test::TrailingSpace->new( { root => '.', filename_regex => qr/(?:(?:\.(?:xs|i|t|pm|pl|PL|yml|json|arc|vim))|README|Changes|LICENSE|MANIFEST)\z/, }, ); # TEST $finder->no_trailing_space( "No trailing space was found." ); Math-Cephes-0.5306/t/99pod.t0000644000175000017500000000032014757021403015163 0ustar shlomifshlomifuse strict; use warnings; use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; my @poddirs = qw( blib ); all_pod_files_ok( all_pod_files( @poddirs ) ); Math-Cephes-0.5306/t/poly.t0000644000175000017500000002104014757021403015204 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..156\n";} END {print "not ok 1\n" unless $loaded;} use Math::Cephes::Polynomial qw(poly); $loaded = 1; print "ok 1\n"; ######################### End of black magic. my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } eval {require Math::Complex; import Math::Complex qw(Re Im);}; my $skip_mc; $skip_mc = 'no Math::Complex' if $@; eval {local $^W=0; require Math::Fraction; }; my $skip_mf; $skip_mf = 'no Math::Fraction' if $@; my $a = Math::Cephes::Polynomial->new([1,-2,3]); $a->clr(2); ok( $a->coef->[0], 0); my $b = Math::Cephes::Polynomial->new([1,2,3]); my $c = [4,6,6,7]; my $d = $b->add($c)->coef; ok( $d->[0], 5); ok( $d->[1], 8); $c = Math::Cephes::Polynomial->new($c); my $e = $c->sub($b); ok( $e->coef->[0], 3); ok( $e->coef->[1], 4); ok( $e->coef->[3], 7); my $f = $e->new()->coef; ok( $f->[0], 3); ok( $f->[1], 4); ok( $f->[3], 7); my $h = $b->cos()->coef; ok( $h->[0], 0.5403023059); ok( $h->[1], -1.68294197); ok( $h->[2], -3.605017566); my $i = $b->sin()->coef; ok( $i->[0], 0.8414709848); ok( $i->[1], 1.080604612); ok( $i->[2], -0.062035052); my $j = $b->sqt()->coef; ok( $j->[0], 1); ok( $j->[1], 1); ok( $j->[2], 1); my $s = $b->eval(5); ok( $s, 86); $s = $b->eval(-2); ok( $s, 9); my $g = $b->mul($c); my $gd = $g->coef; ok( $gd->[0], 4); ok( $gd->[2], 30); ok( $gd->[5], 21); $s = $g->eval(0.5); ok( $s, 25.78125); my $k = $c->sbt($b); my $kd = $k->coef; ok( $kd->[0], 23); ok( $kd->[2], 225); ok( $kd->[5], 378); ok( $kd->[6], 189); $s = $k->eval(-0.5); ok( $s, 14.828125); my $m = $b->div($c)->coef; ok( $m->[0], 4); ok( $m->[2], -2); ok( $m->[5], 5); my $n = $b->atn($c)->coef; ok( $n->[0], 0.2449786631); ok( $n->[2], 0.1730103806); # This test seems to fail consistently on some platforms #ok( $n->[3], -0.8637628062); my $w = Math::Cephes::Polynomial->new([-2, 0, -1, 0, 1]); my ($flag, $r) = $w->rts(); any($r, 0, 1); any($r, 0, -1); any($r, sqrt(2), 0); any($r, -sqrt(2), 0); my $u1 = Math::Cephes::Complex->new(2,1); my $u2 = Math::Cephes::Complex->new(1,-3); my $u3 = Math::Cephes::Complex->new(2,4); my $v1 = Math::Cephes::Complex->new(1,3); my $v2 = Math::Cephes::Complex->new(2,4); my $z1 = Math::Cephes::Polynomial->new([$u1, $u2, $u3]); my $z2 = Math::Cephes::Polynomial->new([$v1, $v2]); my $z3 = $z1->mul($z2)->coef; ok( $z3->{r}->[0], -1); ok( $z3->{r}->[1], 10); ok( $z3->{r}->[2], 4); ok( $z3->{r}->[3], -12); ok( $z3->{i}->[0], 7); ok( $z3->{i}->[1], 10); ok( $z3->{i}->[2], 8); ok( $z3->{i}->[3], 16); $z3 = $z1->add($z2)->coef; ok( $z3->{r}->[0], 3); ok( $z3->{r}->[1], 3); ok( $z3->{r}->[2], 2); ok( $z3->{i}->[0], 4); ok( $z3->{i}->[1], 1); ok( $z3->{i}->[2], 4); $z3 = $z2->sub($z1)->coef; ok( $z3->{r}->[0], -1); ok( $z3->{r}->[1], 1); ok( $z3->{r}->[2], -2); ok( $z3->{i}->[0], 2); ok( $z3->{i}->[1], 7); ok( $z3->{i}->[2], -4); my $z4 = $z2->eval(10); ok($z4->r, 21); ok($z4->i, 43); if ($skip_mc) { for (1 .. 10) { ok(1,1,$skip_mc); } } else { my $u1 = Math::Complex->make(2,1); my $u2 = Math::Complex->make(1,-3); my $u3 = Math::Complex->make(2,4); my $v1 = Math::Complex->make(1,3); my $v2 = Math::Complex->make(2,4); my $z1 = Math::Cephes::Polynomial->new([$u1, $u2, $u3]); my $z2 = Math::Cephes::Polynomial->new([$v1, $v2]); my $z3 = $z1->mul($z2)->coef; ok( $z3->{r}->[0], -1); ok( $z3->{r}->[1], 10); ok( $z3->{r}->[2], 4); ok( $z3->{r}->[3], -12); ok( $z3->{i}->[0], 7); ok( $z3->{i}->[1], 10); ok( $z3->{i}->[2], 8); ok( $z3->{i}->[3], 16); my $z4 = $z2->eval(10); ok(Re($z4), 21); ok(Im($z4), 43); } my $a1 = Math::Cephes::Fraction->new(1,2); my $a2 = Math::Cephes::Fraction->new(2,1); my $a3 = Math::Cephes::Fraction->new(3,6); my $b1 = Math::Cephes::Fraction->new(1,2); my $b2 = Math::Cephes::Fraction->new(2,2); my $f1 = Math::Cephes::Polynomial->new([$a1, $a2, $a3]); my $f2 = Math::Cephes::Polynomial->new([$b1, $b2]); my $f3 = $f1->add($f2)->coef; ok( $f3->{n}->[0], 1); ok( $f3->{n}->[1], 3); ok( $f3->{n}->[2], 1); ok( $f3->{d}->[0], 1); ok( $f3->{d}->[1], 1); ok( $f3->{d}->[2], 2); $f3 = $f1->sub($f2)->coef; ok( $f3->{n}->[0], 0); ok( $f3->{n}->[1], 1); ok( $f3->{n}->[2], 1); ok( $f3->{d}->[0], 1); ok( $f3->{d}->[1], 1); ok( $f3->{d}->[2], 2); $f3 = $f1->mul($f2)->coef; ok( $f3->{n}->[0], 1); ok( $f3->{n}->[1], 3); ok( $f3->{n}->[2], 9); ok( $f3->{n}->[3], 1); ok( $f3->{d}->[0], 4); ok( $f3->{d}->[1], 2); ok( $f3->{d}->[2], 4); ok( $f3->{d}->[3], 2); my $f4obj = $f2->new(); my $f4 = $f4obj->coef; ok( $f4->{n}->[0], 1); ok( $f4->{n}->[1], 1); ok( $f4->{d}->[0], 2); ok( $f4->{d}->[1], 1); $f4obj->clr(7); $f4 = $f4obj->coef; ok( $f4->{n}->[0], 0); ok( $f4->{n}->[1], 0); ok( $f4->{d}->[0], 1); ok( $f4->{d}->[1], 1); my $f2c = $f2->coef; ok( $f2c->{n}->[0], 1); ok( $f2c->{n}->[1], 1); ok( $f2c->{d}->[0], 2); ok( $f2c->{d}->[1], 1); my $f5 = $f2->eval(Math::Cephes::Fraction->new(3,7)); ok( $f5->n, 13); ok( $f5->d, 14); $f5 = $f2->eval(8); ok( $f5->n, 17); ok( $f5->d, 2); my $f6 = $f2->sbt($f1)->coef; ok( $f6->{n}->[0], 1); ok( $f6->{n}->[1], 2); ok( $f6->{n}->[2], 1); ok( $f6->{d}->[0], 1); ok( $f6->{d}->[1], 1); ok( $f6->{d}->[2], 2); my $f7 = $f2->sin()->coef; ok($f7->[0], 0.4794255386); ok($f7->[1], 0.8775825619); $f7 = $f2->cos()->coef; ok($f7->[0], 0.8775825619); ok($f7->[1], -0.4794255386); $f7 = $f2->sqt()->coef; ok($f7->[0], 0.707106781); ok($f7->[1], 0.707106781); $f7 = $f2->atn($f1)->coef; ok($f7->[0], 0.7853981635); ok($f7->[1], -1); if ($skip_mf) { for (1 .. 10) { ok(1,1,$skip_mf); } } else { local $^W = 0; my $a1 = Math::Fraction->new(1,2); my $a2 = Math::Fraction->new(2,1); my $a3 = Math::Fraction->new(3,6); my $b1 = Math::Fraction->new(1,2); my $b2 = Math::Fraction->new(2,2); my $f1 = Math::Cephes::Polynomial->new([$a1, $a2, $a3]); my $f2 = Math::Cephes::Polynomial->new([$b1, $b2]); my $f3 = $f1->add($f2)->coef; ok( $f3->{n}->[0], 1); ok( $f3->{n}->[1], 3); ok( $f3->{n}->[2], 1); ok( $f3->{d}->[0], 1); ok( $f3->{d}->[1], 1); ok( $f3->{d}->[2], 2); my $f5 = $f2->eval(Math::Fraction->new(3,7)); ok( $f5->{frac}->[0], 13); ok( $f5->{frac}->[1], 14); $f5 = $f2->eval(8); ok( $f5->{frac}->[0], 17); ok( $f5->{frac}->[1], 2); } my $c1 = Math::Cephes::Fraction->new(1,6); my $c2 = Math::Cephes::Fraction->new(-1,12); my $c3 = Math::Cephes::Fraction->new(-103, 216); my $c4 = Math::Cephes::Fraction->new(-5,432); my $c5 = Math::Cephes::Fraction->new(-2,27); my $c6 = Math::Cephes::Fraction->new(1, 432); my $c7 = Math::Cephes::Fraction->new(1, 72); my $q = Math::Cephes::Polynomial->new([$c1,$c2,$c3,$c4,$c5,$c6,$c7]); my ($flag1, $s1) = $q->rts(); any($s1, 0, 2); any($s1, 0, -2); any($s1, 3, 0); any($s1, -3, 0); any($s1, 1/2, 0); any($s1, -2/3, 0); my $w1 = $q->eval(10); ok($w1->n, 359632); ok($w1->d, 27); my $c8 = Math::Cephes::Fraction->new(3,8); my $v = $q->eval($c8); ok($v->n, 139125); ok($v->d, 2097152); my $h1 = $q->sin()->coef; ok( $h1->[0], 0.1658961327); ok( $h1->[1], -0.08217860263); ok( $h1->[2], -0.4708202544); my $i1 = $q->cos()->coef; ok( $i1->[0], 0.9861432316); ok( $i1->[1], 0.01382467772); ok( $i1->[2], 0.07568376966); my $j1 = $q->sqt()->coef; ok( $j1->[0], 0.4082482906); ok( $j1->[1], -0.1020620726); ok( $j1->[2], -0.5967796192); my $d1 = Math::Cephes::Fraction->new(1,6); my $d2 = Math::Cephes::Fraction->new(-1,12); my $d3 = Math::Cephes::Fraction->new(3, 4); my $e1 = Math::Cephes::Polynomial->new([$d1, $d2, $d3]); my $d4 = Math::Cephes::Fraction->new(-1,2); my $d5 = Math::Cephes::Fraction->new(5,3); my $e2 = Math::Cephes::Polynomial->new([$d4, $d5]); my $e3 = $e1->sbt($e2)->coef(); ok($e3->{n}->[0], 19); ok($e3->{d}->[0], 48); ok($e3->{n}->[1], -25); ok($e3->{d}->[1], 18); ok($e3->{n}->[2], 25); ok($e3->{d}->[2], 12); sub any { local $^W = 0; my ($ref, $rtrue, $itrue, $skip) = @_; $skip ||= ''; $count++; $skip = "# skip ($skip)" if $skip; my ($package, $file, $line) = caller; for (my $i=0; $i<@$ref; $i++) { my $rerr = sprintf( "%12.8f", abs($ref->[$i]->r - $rtrue)); my $ierr = sprintf( "%12.8f", abs($ref->[$i]->i - $itrue)); if ($rerr < $eps and $ierr < $eps) { print "ok $count $skip\n"; return 1; } } print "not ok $count (expected real=$rtrue and imag=$itrue) at $file line $line\n"; } Math-Cephes-0.5306/t/fract.t0000644000175000017500000000247214757021403015330 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..22\n"; } END {print "not ok 1\n" unless $loaded;} use Math::Cephes::Fraction qw(:fract); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $y = fract(5, 6); my $x = fract(1, 3); my $z = $x->radd( $y); ok( $z->n, 7); ok( $z->d, 6); $z = $x->rsub($y); ok( $z->n, -1); ok( $z->d, 2); $z = $x->rmul($y); ok( $z->n, 5); ok( $z->d, 18); $z = $x->rdiv( $y); ok( $z->n, 2); ok( $z->d, 5); my @a = mixed_fract($z); ok( $a[0], 0); ok( $a[1], 2); ok( $a[2], 5); my $n1 = 60; my $n2 = 144; @a = euclid($n1, $n2); ok( $a[0], 12); ok( $a[1], 5); ok( $a[2], 12); $z->n(16); $z->d(3); ok( $z->n, 16); ok( $z->d, 3); @a = mixed_fract($z); ok( $a[0], 5); ok( $a[1], 1); ok( $a[2], 3); $x->n(44); $x->d(55); ok( $x->n, 44); ok( $x->d, 55); Math-Cephes-0.5306/t/bessels.t0000644000175000017500000000276714757021403015700 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..27\n";} END {print "not ok 1\n" unless $loaded;} use Math::Cephes qw(:bessels); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $x = 2; my $y = 20; my $n = 5; my $v = 3.3; ok( j0($x), .2238907791); ok( j0($y), .1670246643); ok( j1($x), .5767248078); ok( j1($y), .06683312418); ok( jn($n, $x), .007039629756); ok( jn($n, $y), .1511697680); ok( jv($v, $x), .08901510322); ok( jv($v, $y), -.02862625778); ok( y0($x), .5103756726); ok( y0($y), .06264059681); ok( y1($x), -.1070324315); ok( y1($y), -.1655116144 ); ok( yn($n, $x), -9.935989128 ); ok( yn($n, $y), -.1000357679); ok( yv($v, $x), -1.412002815 ); ok( yv($v, $y), .1773183649); ok( i0($x), 2.279585302); ok( i0e($y), .08978031187); ok( i1($x), 1.590636855 ); ok( i1e($y), .08750622217); ok( iv($v, $x), .1418012924); ok( k0($x), .1138938727); ok( k0e($y), .2785448766 ); ok( k1($x), .1398658818); ok( k1e($y), .2854254970); ok( kn($n, $x), 9.431049101) Math-Cephes-0.5306/t/lib/0000755000175000017500000000000014757250372014616 5ustar shlomifshlomifMath-Cephes-0.5306/t/lib/Utils.pm0000644000175000017500000000756714757021403016262 0ustar shlomifshlomifpackage Utils; use strict; use warnings; require Exporter; our @ISA = qw/Exporter/; our @EXPORT_OK = qw/is_between compare_hash_by_ranges is_array_between/; use Test::More; sub is_between { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($have, $want_bottom, $want_top, $blurb) = @_; ok ( _is_between($have, $want_bottom, $want_top), $blurb ); } sub is_array_between { local $Test::Builder::Level = $Test::Builder::Level + 1; my ($got_array_ref, $expected_array_ref, $low_tolerance, $high_tolerance, $blurb) = @_; my $success = 1; if (scalar @$expected_array_ref != scalar @$got_array_ref) { $success = 0; diag('Arrays have different lengths'); } else { for my $idx (0 .. $#$got_array_ref) { my $expected_bottom = $expected_array_ref->[$idx] - $low_tolerance; my $expected_top = $expected_array_ref->[$idx] + $high_tolerance; unless (_is_between($got_array_ref->[$idx], $expected_bottom, $expected_top)) { $success = 0; diag(<<"EOF"); Value $idx is out of range: Got: [$got_array_ref->[$idx]] Expected: [$expected_bottom, $expected_top, $expected_array_ref->[$idx]] EOF last; } } } ok($success, $blurb); } sub compare_hash_by_ranges { local $Test::Builder::Level = $Test::Builder::Level + 1; my $got_hash_ref = shift; my $expected = shift; my $blurb = shift; my $got = [ map { [$_, $got_hash_ref->{$_} ] } sort { $a <=> $b } keys(%$got_hash_ref) ] ; my $success = 1; if (scalar(@$expected) != scalar(@$got)) { $success = 0; diag("Number of keys differ in hashes."); } else { COMPARE_KEYS: for my $idx (0 .. $#$got) { my ($got_key, $got_val) = @{$got->[$idx]}; my ($expected_bottom, $expected_top, $expected_val) = @{$expected->[$idx]}; if (! ( ($got_key >= $expected_bottom) && ($got_key <= $expected_top) && ($got_val == $expected_val) ) ) { $success = 0; diag(<<"EOF"); Key/Val pair No. $idx is out of range or wrong: Got: [$got_key, $got_val] Expected: [$expected_bottom, $expected_top, $expected_val] EOF last COMPARE_KEYS; } } } ok($success, $blurb); } sub _is_between { my ($have, $want_bottom, $want_top,) = @_; return (($have >= $want_bottom) && ($want_top >= $have)); } 1; =pod =head1 AUTHOR Shlomi Fish, L , C =head1 COPYRIGHT Copyright(c) 2012 by Shlomi Fish. =head1 LICENSE This file is licensed under the MIT/X11 License: http://www.opensource.org/licenses/mit-license.php. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =cut Math-Cephes-0.5306/t/misc.t0000644000175000017500000000371214757021403015162 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..33\n";} END {print "not ok 1\n" unless $loaded;} use Math::Cephes qw(:misc :constants :trigs); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-06; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $x = 2.2; my $n = 3; ok( zetac($x), .490543257); ok( zeta($x, $n), .2729056157); ok( dawsn($x), .2645107600); my ($flagf, $S, $C) = fresnl($x); ok( $flagf, 0); ok( $S, .4557046121); ok( $C, .6362860449); my ($flagt, $Si, $Ci) = sici($x); ok( $flagt, 0); ok( $Si, 1.687624827); ok( $Ci, .3750745990); my ($flagh, $Shi, $Chi) = shichi($x); ok( $flagh, 0); ok( $Shi, 2.884902918); ok( $Chi, 2.847711781); ok( expn($n, $x), .02352065665); ok( ei($x), 5.732614700); ok( spence($x), -.9574053086); my ($flaga, $ai, $aiprime, $bi, $biprime) = airy($x); ok( $flaga, 0); ok( $ai, .02561040442); ok( $aiprime, -.04049726324); ok( $bi, 4.267036582); ok( $biprime, 5.681541770); ok( erf($x), .9981371537); ok( erfc($x), .001862846298); ok( struve($n, $x), .1186957024); my $r = plancki(0.1, 200); ok( $r, 90.72805158); $r = simpson(\&fun, 0, 100, 1e-8, 1e-06, 100); ok( $r, sin(100)); my ($num, $den) = bernum(16); ok( $num, -3617); ok( $den, 510); ($num, $den) = bernum(); ok( $num->[26], 8553103); ok( $den->[26], 6); ok( polylog(3, 0.2), 0.2053241957); ok( polylog(7, 1), 1.008349277); my $v1 = [1, 2, -1]; my $v2 = [2, -1, 3]; my $c = -3 / sqrt(6) / sqrt(14); ok( vecang($v1, $v2), acos($c)); sub fun { my $x = shift; return cos($x); } Math-Cephes-0.5306/t/gammas.t0000644000175000017500000000211114757021403015464 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..10\n"; } END {print "not ok 1\n" unless $loaded;} use Math::Cephes qw(:gammas :constants :utils); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $x = 0.5; my $euler = 0.57721566490153286061; my $e = exp(1); ok( gamma($x), sqrt($PI)); ok( lgam($x), log(sqrt($PI))); ok( gamma(10), fac(9)); ok( fac(9), 362880); ok( rgamma($x), 1/sqrt($PI)); ok( psi(1/2), -$euler - 2*$LOGE2); ok( igam(4,4), 1-71/3*pow($e,-4)); my $p = igamc(4,4); ok( $p, 71/3*pow($e, -4)); ok( igami(4,$p), 4); Math-Cephes-0.5306/t/cpan-changes.t0000644000175000017500000000026214757021403016553 0ustar shlomifshlomif#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::CPAN::Changes"; plan skip_all => 'Test::CPAN::Changes required for this test' if $@; changes_ok(); Math-Cephes-0.5306/t/new_cmplx-2.t0000644000175000017500000000053414757021403016361 0ustar shlomifshlomif#!/usr/bin/perl use strict; use warnings; use Test::More tests => 1; use Math::Cephes qw(:cmplx); my $x = new_cmplx(3, 5); my $y = new_cmplx(2, 3); my $z = new_cmplx(); cdiv( $x, $y, $z ); # TEST like( "$z->{r},$z->{i}", qr/\A0\.617.*?,-0\.0294/, "use Math::Cephes qw(:cmplx) works without explicit use Math::Cephes::Complex", ); Math-Cephes-0.5306/t/betas.t0000644000175000017500000000171114757021403015322 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..5\n"; } END {print "not ok 1\n" unless $loaded;} use Math::Cephes qw(:betas :constants :gammas); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $x = 5.57; my $y = 2.2; my $u = 0.3; my $z = beta($x, $y); ok( $z, gamma($x)*gamma($y)/gamma(7.77)); ok( lbeta($x, $y), log($z)); $z = incbet($x, $y, $u); ok( $z, 0.00761009624); ok( incbi($x, $y, $z), $u); Math-Cephes-0.5306/t/utils.t0000644000175000017500000000230314757021403015362 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..20\n"; } END {print "not ok 1\n" unless $loaded;} use Math::Cephes qw(:utils :constants); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $x = 5.57; my $y = -5.43; ok( ceil($x), 6); ok( floor($x), 5); ok( round($x), 6); ok( ceil($y), -5); ok( floor($y), -6); ok( round($y), -5); ok( sqrt(2), $SQRT2); ok( sqrt(2/$PI), $SQ2OPI); ok( cbrt(729), 9); ok( cbrt(704.969), 8.9); ok( fabs($y), 5.43); ok( pow(2,10), 1024); ok( powi(2,10), 1024); ok( pow(5,1/3), cbrt(5)); ok( fac(10), 3628800); my ($z, $expnt) = frexp(6); ok( $z, .75); ok( $expnt, 3); ok( ldexp(.75, 3), 6); ok( lsqrt(2147483647), 46341); Math-Cephes-0.5306/t/trig.t0000644000175000017500000000215614757021403015175 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..16\n"; } END {print "not ok 1\n" unless $loaded;} use Math::Cephes qw(:trigs :constants); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $x = 7*$PI + $PIO4; my $y = 945; ok( -sin($x), $SQRTH); ok( -cos($x), $SQRTH); ok( tan($x), 1); ok( cot($x), 1); ok( acos($SQRTH), $PIO4); ok( asin($SQRTH), $PIO4); ok( atan(1), $PIO4); ok( atan2(sqrt(3), 1), $PI/3); ok( -sindg($y), $SQRTH); ok( -cosdg($y), $SQRTH); ok( tandg($y), 1); ok( cotdg($y), 1); ok( radian(359, 59, 60), 2*$PI); ok( cosm1(0), 0); ok( hypot(5, 12), 13); Math-Cephes-0.5306/t/cmplx.t0000644000175000017500000000522714757021403015355 0ustar shlomifshlomif#!/usr/bin/perl use strict; use warnings; ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use vars qw($loaded); BEGIN {$| = 1; print "1..50\n"; } END {print "not ok 1\n" unless $loaded;} use Math::Cephes qw(:hypers :trigs :constants); #use Math::Cephes::Complex qw(:cmplx); use Math::Cephes::Complex; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $y = Math::Cephes::Complex->new(1,3); my $x = new Math::Cephes::Complex(5,6); my $z = $x->cadd($y); ok( $z->r, 6); ok( $z->i, 9); $z = $x->csub($y); ok( $z->r, 4); ok( $z->i, 3); $z = $x->cmul($y); ok( $z->r, -13); ok( $z->i, 21); $z = $x->cdiv( $y); ok( $z->r, 2.3); ok( $z->i, -0.9); $z = $z->cneg; ok( $z->r, -2.3); ok( $z->i, 0.9); $z = $x->cmov; ok( $z->r, 5); ok( $z->i, 6); ok( $z->cabs, sqrt(61)); $z = $x->clog; ok( $z->r, log(hypot(5,6))); ok( $z->i, atan2(6,5)); $z = $x->cexp; ok( $z->r, exp(5)*cos(6)); ok( $z->i, exp(5)*sin(6)); $z = $x->csin; my $d = new Math::Cephes::Complex(sin(5)*cosh(6), cos(5)*sinh(6)); ok( $z->r, $d->r); ok( $z->i, $d->i); $z = $d->casin; ok( $z->r, 5-2*$PI); ok( $z->i, 6); $d = new Math::Cephes::Complex(cos(5)*cosh(6), -sin(5)*sinh(6)); $z = $x->ccos; ok( $z->r, $d->r); ok( $z->i, $d->i); $z = $d->cacos; ok( $z->r, 5-2*$PI); ok( $z->i, 6); my $den = cos(10) + cosh(12); $d = new Math::Cephes::Complex(sin(10)/$den, sinh(12)/$den); $z = $x->ctan; ok( $z->r, $d->r); ok( $z->i, $d->i); $z = $d->catan; ok( $z->r, 5-2*$PI); ok( $z->i, 6); $z = $x->ccot; $den = cosh(12) - cos(10); ok( $z->r, sin(10)/$den); ok( $z->i, -sinh(12)/$den); $z = $x->csqrt; ok( $z->r, 3/$z->i); ok( $z->i, sqrt( ( sqrt(61) - 5 ) / 2 ) ); $d = new Math::Cephes::Complex(2,3); $z = $d->csinh; ok( $z->r, sinh(2)*cos(3)); ok( $z->i, cosh(2)*sin(3)); $y = $z->casinh; ok( $y->r, 2); ok( $y->i, 3); $z = $d->ccosh; ok( $z->r, cosh(2)*cos(3)); ok( $z->i, sinh(2)*sin(3)); $y = $z->cacosh; ok( $y->r, 2); ok( $y->i, 3); $den = cosh(4) + cos(6); $z = $d->ctanh; ok( $z->r, sinh(4)/$den); ok( $z->i, sin(6)/$den); $y = $z->catanh; ok( $y->r, 2); ok( $y->i, 3-$PI); $d = new Math::Cephes::Complex(4,5); $z = $d->cpow( $y); my $c = $d->clog; my $f = $y->cmul( $c); my $g = $f->cexp; ok( $z->r, $g->r); ok( $z->i, $g->i); $x->r(55); $x->i(66); ok( $x->r, 55); ok( $x->i, 66); Math-Cephes-0.5306/t/dists.t0000644000175000017500000000346114757021403015356 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..23\n";} END {print "not ok 1\n" unless $loaded;} use Math::Cephes qw(:dists :betas :gammas :constants :misc); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip ($value)\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $k = 2; my $n = 10; my $p = 0.5; my $y = 0.6; ok( bdtr($k, $n, $p), incbet($n-$k, $k+1, 1-$p)); ok( bdtrc($k, $n, $p), incbet($k+1, $n-$k, $p)); ok( bdtri($k, $n, $y), 1-incbi($n-$k, $k+1, $y)); ok( btdtr($k, $n, $y), incbet($k, $n, $y)); ok( chdtr($k, $y), igam($k/2, $y/2)); ok( chdtrc($k, $y), igamc($k/2, $y/2)); ok( chdtri($k, $y), 2*igami($k/2, $y)); ok( fdtr($k, $n, $y), incbet($k/2, $n/2,$k*$y/($n + $k*$y))); ok( fdtrc($k, $n, $y), incbet($n/2, $k/2, $n/($n + $k*$y))); my $z = incbi( $n/2, $k/2, $p); ok( fdtri($k, $n, $p), $n*(1-$z)/($k*$z)); ok( gdtr($k, $n, $y), igam($n, $k*$y)); ok( gdtrc($k, $n, $y), igamc($n, $k*$y)); my $w = nbdtr($k, $n, $p); ok( $w, incbet($n, $k+1, $p)); ok( nbdtrc($k, $n, $p), incbet($k+1, $n, 1-$p)); ok( nbdtri($k, $n, $w), $p); $w = ndtr($y); ok( $w, (1+erf($y/sqrt(2)))/2); ok( ndtri($w), $y); ok( pdtr($k, $n), igamc($k+1, $n)); ok( pdtrc($k, $n), igam($k+1, $n)); ok( pdtri($k, $y), igami($k+1, $y)); $w = stdtr( $k, $y); $z = $k/($k + $y*$y); ok( $w, 1- 0.5*incbet($k/2, 1/2, $z)); ok( stdtri($k, $w), $y); Math-Cephes-0.5306/t/hypergeometrics.t0000644000175000017500000000156614757021403017445 0ustar shlomifshlomif#!/usr/bin/perl ######################### We start with some black magic to print on failure. use lib '../blib/lib','../blib/arch'; use strict; use warnings; use vars qw($loaded); BEGIN {$| = 1; print "1..3\n"; } END {print "not ok 1\n" unless $loaded;} use Math::Cephes qw(:hypergeometrics); $loaded = 1; print "ok 1\n"; ######################### End of black magic. # util my $count = 1; my $eps = 1e-07; sub ok { local($^W) = 0; $count++; my ($package, $file, $line) = caller; my ($value, $true, $skip) = @_; $skip ||= ''; $skip = "# skip ($skip)" if $skip; my $error = sprintf( "%12.8f", abs($value - $true)); print($error < $eps ? "ok $count $skip\n" : "not ok $count (expected $true: got $value) at $file line $line\n"); } my $x = 0.1; my $y = 0.2; my $z = 0.3; my $u = 0.4; ok(hyp2f1($x, $y, $z, $u), 1.03417940155); ok(hyperg($x, $y, $z), 1.17274559901); Math-Cephes-0.5306/README0000644000175000017500000001050514757021403014455 0ustar shlomifshlomifThe Math::Cephes module provides a perl interface to over 150 functions of the cephes math library of Stephen Moshier. Please read the INSTALL file for instructions on installation. The functions available are grouped as - trigonometric: sin, cos, etc., and their inverses; also included are versions of sin, cos, tan, and cot which accept angles in degrees, as well as a degree to radian converter. - hyperbolic: sinh, cosh, tanh, and their inverses. - exponential and logarithmic: exp and log functions, with versions in base e (2.718282...), base 10, and base 2. - Bessel functions: various Bessel functions (J, Y, I, K) of different orders. - Gamma functions: the gamma function, the incomplete gamma integral and its inverse, and the digamma function (psi). - Beta functions: the beta function and the incomplete beta integral and its inverse. - elliptic integrals: complete, incomplete, and Jacobian elliptic integrals. - hypergeometric functions: 2F0, 2F1, 1F2, 3F0, and the confluent hypergeometric function. - distributions: binomial, beta, chi-square, F, gamma, normal, Poisson, and Student's t distribution, as well as their inverses. - miscellaneous: Airy function, Dawson's integral, exponential integrals, error functions, sin/cos and sinh/cosh integrals, Fresnel integral, dilogarithm (Spence integral), the Struve function, Riemann zeta functions, polylogarithms, the Planck distribution, finding the angle between two vectors, and Simpson's rule for estimating an integral. - utilities: square and cube roots, ceiling, floor, round, pseudo random number generators, the power function, the factorial function, and some others. Some common constants, such as PI and SQRT2, are also available. As well, there is support for arithmetic operations for fractions (adding, subtracting, dividing, multiplying) and also for various functions of complex numbers (arithmetic, trigonometric, hyperbolic, exponential, logarithm, powers). Interfaces to these are available in the included Math::Cephes::Fraction and Math::Cephes::Complex modules. There is also support for some common operations for polynomials of a real variable (adding, subtracting, multiplying, dividing, evaluating, root finding) in the included module Math::Cephes::Polynomial, the coefficients of which can be real, fractional, or (for some operations) complex. Finally, routines for square matrices (adding, subtracting, multiplying, dividing, inverting) are available in the included module Math::Cephes::Matrix, which also includes routines for solving simultaneous equations and for finding the eigenvalues and eigenvectors of a real symmetric matrix. A description of these functions and their usage may be read either as a man page (eg, man Math::Cephes) or through perldoc (eg, perldoc Math::Cephes), for the relevant module. A simple "calculator" script (pmath) is included which provides a command line interface to this module; help on the various functions is also available within this script. The script will use the Term::ReadLine module if available. Help on its usage is available either though the man page (man pmath) or perldoc (perldoc pmath). This module has been built and tested on a Linux and on a WinXP machine running ActivePerl (build 6xx); to build on different systems will probably require editing of the file libmd/mconf.h, which among other things defines the type of computer arithmetic used. If you need to edit this file for your system, please let me know of the changes needed, so they can be automatically set in a future release. If you are running ActiveState's Win32 perl (build version 6xx), a ppm package is available at http://theoryx5.uwinnipeg.ca/ppmpackages/ To install, within the ppm shell set the repository to http://theoryx5.uwinnipeg.ca/cgi-bin/ppmserver?urn:/PPMServer and then ppm> install Math-Cephes For Win32 ActivePerl 8xx, the corresponding repository is http://theoryx5.uwinnipeg.ca/ppms/ with the repository location within the ppm shell as http://theoryx5.uwinnipeg.ca/cgi-bin/ppmserver?urn:/PPMServer58 The C code for the Cephes Math Library is Copyright 1984, 1987, 1989, 2002 by Stephen L. Moshier, and is available at http://www.netlib.org/cephes/. The perl interface is Copyright 2000, 2002 by Randy Kobes , and may be distributed under the same terms as Perl itself. Math-Cephes-0.5306/INSTALL0000644000175000017500000000236514757021403014633 0ustar shlomifshlomifThis module requires a C compiler to build. To install the module, first edit libmd/mconf.h to suit your system (the default settings are for Linux/Win32). Then execute the sequence perl Makefile.PL make make test make install If you do not have permission to install modules in the Perl site tree on your system, you can install this in your own library by perl Makefile.PL PREFIX=/home/me/perl \ INSTALLMAN1DIR=/home/me/man/man1 \ INSTALLMAN3DIR=/home/me/man/man3 make make test make install To use modules in this location, either set the PERL5LIB environment variable to include your private module directory, or else put use lib '/home/me/perl/path/to/lib'; at the top of your script. If you need to alter libmd/mconf.h to work on your system, I would be interested in knowing what settings were required, so as to make this configuration more portable. A Win32 ppm package, suitable for use with ActivePerl compatible Perl packages (builds 6xx) is available at http://theoryx5.uwinnipeg.ca/ppmpackages/ To install, within the ppm shell set the repository to http://theoryx5.uwinnipeg.ca/cgi-bin/ppmserver?urn:/PPMServer and then ppm> install Math-Cephes Randy Kobes Math-Cephes-0.5306/libmd/0000755000175000017500000000000014757250372014674 5ustar shlomifshlomifMath-Cephes-0.5306/libmd/ellpk.c0000644000175000017500000001163414757021403016143 0ustar shlomifshlomif/* ellpk.c * * Complete elliptic integral of the first kind * * * * SYNOPSIS: * * double m1, y, ellpk(); * * y = ellpk( m1 ); * * * * DESCRIPTION: * * Approximates the integral * * * * pi/2 * - * | | * | dt * K(m) = | ------------------ * | 2 * | | sqrt( 1 - m md_sin t ) * - * 0 * * where m = 1 - m1, using the approximation * * P(x) - md_log x Q(x). * * The argument m1 is used rather than m so that the logarithmic * singularity at m = 1 will be shifted to the origin; this * preserves maximum accuracy. * * K(0) = pi/2. * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 0,1 16000 3.5e-17 1.1e-17 * IEEE 0,1 30000 2.5e-16 6.8e-17 * * ERROR MESSAGES: * * message condition value returned * ellpk domain x<0, x>1 0.0 * */ /* ellpk.c */ /* Cephes Math Library, Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef DEC static unsigned short P[] = { 0035020,0127576,0040430,0051544, 0036025,0070136,0042703,0153716, 0036402,0122614,0062555,0077777, 0036441,0102130,0072334,0025172, 0036341,0043320,0117242,0172076, 0036312,0146456,0077242,0154141, 0036420,0003467,0013727,0035407, 0036564,0137263,0110651,0020237, 0036775,0001330,0144056,0020305, 0037305,0144137,0157521,0141734, 0040261,0071027,0173721,0147572 }; static unsigned short Q[] = { 0034366,0130371,0103453,0077633, 0035557,0122745,0173515,0113016, 0036302,0124470,0167304,0074473, 0036575,0132403,0117226,0117576, 0036703,0156271,0047124,0147733, 0036766,0137465,0002053,0157312, 0037031,0014423,0154274,0176515, 0037107,0177747,0143216,0016145, 0037217,0177777,0172621,0074000, 0037377,0177777,0177776,0156435, 0040000,0000000,0000000,0000000 }; static unsigned short ac1[] = {0040261,0071027,0173721,0147572}; #define C1 (*(double *)ac1) #endif #ifdef IBMPC static unsigned short P[] = { 0x0a6d,0xc823,0x15ef,0x3f22, 0x7afa,0xc8b8,0xae0b,0x3f62, 0xb000,0x8cad,0x54b1,0x3f80, 0x854f,0x0e9b,0x308b,0x3f84, 0x5e88,0x13d4,0x28da,0x3f7c, 0x5b0c,0xcfd4,0x59a5,0x3f79, 0xe761,0xe2fa,0x00e6,0x3f82, 0x2414,0x7235,0x97d6,0x3f8e, 0xc419,0x1905,0xa05b,0x3f9f, 0x387c,0xfbea,0xb90b,0x3fb8, 0x39ef,0xfefa,0x2e42,0x3ff6 }; static unsigned short Q[] = { 0x6ff3,0x30e5,0xd61f,0x3efe, 0xb2c2,0xbee9,0xf4bc,0x3f4d, 0x8f27,0x1dd8,0x5527,0x3f78, 0xd3f0,0x73d2,0xb6a0,0x3f8f, 0x99fb,0x29ca,0x7b97,0x3f98, 0x7bd9,0xa085,0xd7e6,0x3f9e, 0x9faa,0x7b17,0x2322,0x3fa3, 0xc38d,0xf8d1,0xfffc,0x3fa8, 0x2f00,0xfeb2,0xffff,0x3fb1, 0xdba4,0xffff,0xffff,0x3fbf, 0x0000,0x0000,0x0000,0x3fe0 }; static unsigned short ac1[] = {0x39ef,0xfefa,0x2e42,0x3ff6}; #define C1 (*(double *)ac1) #endif #ifdef MIEEE static unsigned short P[] = { 0x3f22,0x15ef,0xc823,0x0a6d, 0x3f62,0xae0b,0xc8b8,0x7afa, 0x3f80,0x54b1,0x8cad,0xb000, 0x3f84,0x308b,0x0e9b,0x854f, 0x3f7c,0x28da,0x13d4,0x5e88, 0x3f79,0x59a5,0xcfd4,0x5b0c, 0x3f82,0x00e6,0xe2fa,0xe761, 0x3f8e,0x97d6,0x7235,0x2414, 0x3f9f,0xa05b,0x1905,0xc419, 0x3fb8,0xb90b,0xfbea,0x387c, 0x3ff6,0x2e42,0xfefa,0x39ef }; static unsigned short Q[] = { 0x3efe,0xd61f,0x30e5,0x6ff3, 0x3f4d,0xf4bc,0xbee9,0xb2c2, 0x3f78,0x5527,0x1dd8,0x8f27, 0x3f8f,0xb6a0,0x73d2,0xd3f0, 0x3f98,0x7b97,0x29ca,0x99fb, 0x3f9e,0xd7e6,0xa085,0x7bd9, 0x3fa3,0x2322,0x7b17,0x9faa, 0x3fa8,0xfffc,0xf8d1,0xc38d, 0x3fb1,0xffff,0xfeb2,0x2f00, 0x3fbf,0xffff,0xffff,0xdba4, 0x3fe0,0x0000,0x0000,0x0000 }; static unsigned short ac1[] = { 0x3ff6,0x2e42,0xfefa,0x39ef }; #define C1 (*(double *)ac1) #endif #ifdef UNK static double P[] = { 1.37982864606273237150E-4, 2.28025724005875567385E-3, 7.97404013220415179367E-3, 9.85821379021226008714E-3, 6.87489687449949877925E-3, 6.18901033637687613229E-3, 8.79078273952743772254E-3, 1.49380448916805252718E-2, 3.08851465246711995998E-2, 9.65735902811690126535E-2, 1.38629436111989062502E0 }; static double Q[] = { 2.94078955048598507511E-5, 9.14184723865917226571E-4, 5.94058303753167793257E-3, 1.54850516649762399335E-2, 2.39089602715924892727E-2, 3.01204715227604046988E-2, 3.73774314173823228969E-2, 4.88280347570998239232E-2, 7.03124996963957469739E-2, 1.24999999999870820058E-1, 4.99999999999999999821E-1 }; static double C1 = 1.3862943611198906188E0; /* md_log(4) */ #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_log ( double ); #else double polevl(), p1evl(), md_log(); #endif extern double MACHEP, MAXNUM; double ellpk(x) double x; { if( (x < 0.0) || (x > 1.0) ) { mtherr( "ellpk", DOMAIN ); return( 0.0 ); } if( x > MACHEP ) { return( polevl(x,P,10) - md_log(x) * polevl(x,Q,10) ); } else { if( x == 0.0 ) { mtherr( "ellpk", SING ); return( MAXNUM ); } else { return( C1 - 0.5 * md_log(x) ); } } } Math-Cephes-0.5306/libmd/unity.c0000644000175000017500000000522114757021403016177 0ustar shlomifshlomif/* unity.c * * Relative error approximations for function arguments near * unity. * * md_log1p(x) = md_log(1+x) * expm1(x) = md_exp(x) - 1 * cosm1(x) = md_cos(x) - 1 * */ #include "mconf.h" #ifdef ANSIPROT extern int isnan (double); extern int isfinite (double); extern double md_log ( double ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_exp ( double ); extern double md_cos ( double ); #else double md_log(), polevl(), p1evl(), md_exp(), md_cos(); int isnan(), isfinite(); #endif extern double INFINITY; /* md_log1p(x) = md_log(1 + x) */ /* Coefficients for md_log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) * 1/sqrt(2) <= x < sqrt(2) * Theoretical peak relative error = 2.32e-20 */ static double LP[] = { 4.5270000862445199635215E-5, 4.9854102823193375972212E-1, 6.5787325942061044846969E0, 2.9911919328553073277375E1, 6.0949667980987787057556E1, 5.7112963590585538103336E1, 2.0039553499201281259648E1, }; static double LQ[] = { /* 1.0000000000000000000000E0,*/ 1.5062909083469192043167E1, 8.3047565967967209469434E1, 2.2176239823732856465394E2, 3.0909872225312059774938E2, 2.1642788614495947685003E2, 6.0118660497603843919306E1, }; #define SQRTH 0.70710678118654752440 #define SQRT2 1.41421356237309504880 double md_log1p(x) double x; { double z; z = 1.0 + x; if( (z < SQRTH) || (z > SQRT2) ) return( md_log(z) ); z = x*x; z = -0.5 * z + x * ( z * polevl( x, LP, 6 ) / p1evl( x, LQ, 6 ) ); return (x + z); } /* expm1(x) = md_exp(x) - 1 */ /* e^x = 1 + 2x P(x^2)/( Q(x^2) - P(x^2) ) * -0.5 <= x <= 0.5 */ static double EP[3] = { 1.2617719307481059087798E-4, 3.0299440770744196129956E-2, 9.9999999999999999991025E-1, }; static double EQ[4] = { 3.0019850513866445504159E-6, 2.5244834034968410419224E-3, 2.2726554820815502876593E-1, 2.0000000000000000000897E0, }; double expm1(x) double x; { double r, xx; #ifdef NANS if( isnan(x) ) return(x); #endif #ifdef INFINITIES if( x == INFINITY ) return(INFINITY); if( x == -INFINITY ) return(-1.0); #endif if( (x < -0.5) || (x > 0.5) ) return( md_exp(x) - 1.0 ); xx = x * x; r = x * polevl( xx, EP, 2 ); r = r/( polevl( xx, EQ, 3 ) - r ); return (r + r); } /* cosm1(x) = md_cos(x) - 1 */ static double coscof[7] = { 4.7377507964246204691685E-14, -1.1470284843425359765671E-11, 2.0876754287081521758361E-9, -2.7557319214999787979814E-7, 2.4801587301570552304991E-5, -1.3888888888888872993737E-3, 4.1666666666666666609054E-2, }; extern double PIO4; double cosm1(x) double x; { double xx; if( (x < -PIO4) || (x > PIO4) ) return( md_cos(x) - 1.0 ); xx = x * x; xx = -0.5*xx + xx * xx * polevl( xx, coscof, 6 ); return xx; } Math-Cephes-0.5306/libmd/simpsn.c0000644000175000017500000000304514757021403016342 0ustar shlomifshlomif/* simpsn.c */ /* simpsn.c * Numerical integration of function tabulated * at equally spaced arguments */ /* Coefficients for Cote integration formulas */ /* Note: these numbers were computed using 40-decimal precision. */ #define NCOTE 8 /* 6th order formula */ /* static double simcon[] = { 4.88095238095238095E-2, 2.57142857142857142857E-1, 3.2142857142857142857E-2, 3.2380952380952380952E-1, }; */ /* 8th order formula */ static double simcon[] = { 3.488536155202821869E-2, 2.076895943562610229E-1, -3.27336860670194003527E-2, 3.7022927689594356261E-1, -1.6014109347442680776E-1, }; /* 10th order formula */ /* static double simcon[] = { 2.68341483619261397039E-2, 1.77535941424830313719E-1, -8.1043570626903960237E-2, 4.5494628827962161295E-1, -4.3515512265512265512E-1, 7.1376463043129709796E-1, }; */ /* simpsn.c 2 */ /* 20th order formula */ /* static double simcon[] = { 1.182527324903160319E-2, 1.14137717644606974987E-1, -2.36478370511426964E-1, 1.20618689348187566E+0, -3.7710317267153304677E+0, 1.03367982199398011435E+1, -2.270881584397951229796E+1, 4.1828057422193554603E+1, -6.4075279490154004651555E+1, 8.279728347247285172085E+1, -9.0005367135242894657916E+1, }; */ /* simpsn.c 3 */ double simpsn( f, delta ) double f[]; /* tabulated function */ double delta; /* spacing of arguments */ { extern double simcon[]; double ans; int i; ans = simcon[NCOTE/2] * f[NCOTE/2]; for( i=0; i < NCOTE/2; i++ ) ans += simcon[i] * ( f[i] + f[NCOTE-i] ); return( ans * delta * NCOTE ); } Math-Cephes-0.5306/libmd/sqrt.c.src0000644000175000017500000000544314757021403016614 0ustar shlomifshlomif/* sqrt.c * * Square root * * * * SYNOPSIS: * * double x, y, sqrt(); * * y = sqrt( x ); * * * * DESCRIPTION: * * Returns the square root of x. * * Range reduction involves isolating the power of two of the * argument and using a polynomial approximation to obtain * a rough value for the square root. Then Heron's iteration * is used three times to converge to an accurate value. * * * * ACCURACY: * * * Relative error: * arithmetic domain # trials peak rms * DEC 0, 10 60000 2.1e-17 7.9e-18 * IEEE 0,1.7e308 30000 1.7e-16 6.3e-17 * * * ERROR MESSAGES: * * message condition value returned * sqrt domain x < 0 0.0 * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double frexp ( double, int * ); extern double ldexp ( double, int ); #else double frexp(), ldexp(); #endif extern double SQRT2; /* SQRT2 = 1.41421356237309504880 */ double sqrt(x) double x; { int e; #ifndef UNK short *q; #endif double z, w; if( x <= 0.0 ) { if( x < 0.0 ) mtherr( "sqrt", DOMAIN ); return( 0.0 ); } w = x; /* separate exponent and significand */ #ifdef UNK z = frexp( x, &e ); #endif #ifdef DEC q = (short *)&x; e = ((*q >> 7) & 0377) - 0200; *q &= 0177; *q |= 040000; z = x; #endif /* Note, frexp and ldexp are used in order to * handle denormal numbers properly. */ #ifdef IBMPC z = frexp( x, &e ); q = (short *)&x; q += 3; /* e = ((*q >> 4) & 0x0fff) - 0x3fe; *q &= 0x000f; *q |= 0x3fe0; z = x; */ #endif #ifdef MIEEE z = frexp( x, &e ); q = (short *)&x; /* e = ((*q >> 4) & 0x0fff) - 0x3fe; *q &= 0x000f; *q |= 0x3fe0; z = x; */ #endif /* approximate square root of number between 0.5 and 1 * relative error of approximation = 7.47e-3 */ x = 4.173075996388649989089E-1 + 5.9016206709064458299663E-1 * z; /* adjust for odd powers of 2 */ if( (e & 1) != 0 ) x *= SQRT2; /* re-insert exponent */ #ifdef UNK x = ldexp( x, (e >> 1) ); #endif #ifdef DEC *q += ((e >> 1) & 0377) << 7; *q &= 077777; #endif #ifdef IBMPC x = ldexp( x, (e >> 1) ); /* *q += ((e >>1) & 0x7ff) << 4; *q &= 077777; */ #endif #ifdef MIEEE x = ldexp( x, (e >> 1) ); /* *q += ((e >>1) & 0x7ff) << 4; *q &= 077777; */ #endif /* Newton iterations: */ #ifdef UNK x = 0.5*(x + w/x); x = 0.5*(x + w/x); x = 0.5*(x + w/x); #endif /* Note, assume the square root cannot be denormal, * so it is safe to use integer exponent operations here. */ #ifdef DEC x += w/x; *q -= 0200; x += w/x; *q -= 0200; x += w/x; *q -= 0200; #endif #ifdef IBMPC x += w/x; *q -= 0x10; x += w/x; *q -= 0x10; x += w/x; *q -= 0x10; #endif #ifdef MIEEE x += w/x; *q -= 0x10; x += w/x; *q -= 0x10; x += w/x; *q -= 0x10; #endif return(x); } Math-Cephes-0.5306/libmd/setprec.6880000644000175000017500000000142514757021403016601 0ustar shlomifshlomif/* Set 68881/2 floating point rounding precision */ /* Reference: MC68881/MC68882 Floating-Point Coprocessor */ /* User's Manual, Motorola, Prentice-Hall, 1987 (First Edition) */ /* Pages 1-14, 2-3, 4-68. */ /* FPcr code $80 sets the 68882 coprocessor to */ /* rounding precision = 53 bits */ /* rounding mode = nearest or even */ /* all exceptions (bits 8-15) disabled */ /* The instruction is */ /* FMOVE.L #$80,Fcr */ /* if the assembler will understand it. */ .align 2 .text /* set to single precision */ .globl _sprec _sprec .word 0xf23c,0x9000,0x0000,0x0040 rts /* set to double precision */ .globl _dprec _dprec: .word 0xf23c,0x9000,0x0000,0x0080 rts /* set to extended (long double) precision */ .globl _ldprec _ldprec: .word 0xf23c,0x9000,0x0000,0x0000 rts Math-Cephes-0.5306/libmd/yn.c0000644000175000017500000000355514757021403015465 0ustar shlomifshlomif/* md_yn.c * * Bessel function of second kind of integer order * * * * SYNOPSIS: * * double x, y, md_yn(); * int n; * * y = md_yn( n, x ); * * * * DESCRIPTION: * * Returns Bessel function of order n, where n is a * (possibly negative) integer. * * The function is evaluated by forward recurrence on * n, starting with values computed by the routines * md_y0() and md_y1(). * * If n = 0 or 1 the routine for md_y0 or md_y1 is called * directly. * * * * ACCURACY: * * * Absolute error, except relative * when y > 1: * arithmetic domain # trials peak rms * DEC 0, 30 2200 2.9e-16 5.3e-17 * IEEE 0, 30 30000 3.4e-15 4.3e-16 * * * ERROR MESSAGES: * * message condition value returned * md_yn singularity x = 0 MAXNUM * md_yn overflow MAXNUM * * Spot checked against tables for x, n between 0 and 100. * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double md_y0 ( double ); extern double md_y1 ( double ); extern double md_log ( double ); #else double md_y0(), md_y1(), md_log(); #endif extern double MAXNUM, MAXLOG; double md_yn( n, x ) int n; double x; { double an, anm1, anm2, r; int k, sign; if( n < 0 ) { n = -n; if( (n & 1) == 0 ) /* -1**n */ sign = 1; else sign = -1; } else sign = 1; if( n == 0 ) return( sign * md_y0(x) ); if( n == 1 ) return( sign * md_y1(x) ); /* test for overflow */ if( x <= 0.0 ) { mtherr( "md_yn", SING ); return( -MAXNUM ); } /* forward recurrence on n */ anm2 = md_y0(x); anm1 = md_y1(x); k = 1; r = 2 * k; do { an = r * anm1 / x - anm2; anm2 = anm1; anm1 = an; r += 2.0; ++k; } while( k < n ); return( sign * an ); } Math-Cephes-0.5306/libmd/cosh.c0000644000175000017500000000247614757021403015774 0ustar shlomifshlomif/* md_cosh.c * * Hyperbolic cosine * * * * SYNOPSIS: * * double x, y, md_cosh(); * * y = md_cosh( x ); * * * * DESCRIPTION: * * Returns hyperbolic cosine of argument in the range MINLOG to * MAXLOG. * * md_cosh(x) = ( md_exp(x) + md_exp(-x) )/2. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC +- 88 50000 4.0e-17 7.7e-18 * IEEE +-MAXLOG 30000 2.6e-16 5.7e-17 * * * ERROR MESSAGES: * * message condition value returned * md_cosh overflow |x| > MAXLOG MAXNUM * * */ /* md_cosh.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1985, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double md_exp ( double ); extern int isnan ( double ); extern int isfinite ( double ); #else double md_exp(); int isnan(), isfinite(); #endif extern double MAXLOG, INFINITY, LOGE2; double md_cosh(x) double x; { double y; #ifdef NANS if( isnan(x) ) return(x); #endif if( x < 0 ) x = -x; if( x > (MAXLOG + LOGE2) ) { mtherr( "md_cosh", OVERFLOW ); return( INFINITY ); } if( x >= (MAXLOG - LOGE2) ) { y = md_exp(0.5 * x); y = (0.5 * y) * y; return(y); } y = md_exp(x); y = 0.5 * (y + 1.0 / y); return( y ); } Math-Cephes-0.5306/libmd/hyp2f1.c0000644000175000017500000002050114757021403016136 0ustar shlomifshlomif/* hyp2f1.c * * Gauss hypergeometric function F * 2 1 * * * SYNOPSIS: * * double a, b, c, x, y, hyp2f1(); * * y = hyp2f1( a, b, c, x ); * * * DESCRIPTION: * * * hyp2f1( a, b, c, x ) = F ( a, b; c; x ) * 2 1 * * inf. * - a(a+1)...(a+k) b(b+1)...(b+k) k+1 * = 1 + > ----------------------------- x . * - c(c+1)...(c+k) (k+1)! * k = 0 * * Cases addressed are * Tests and escapes for negative integer a, b, or c * Linear transformation if c - a or c - b negative integer * Special case c = a or c = b * Linear transformation for x near +1 * Transformation for x < -0.5 * Psi function expansion if x > 0.5 and c - a - b integer * Conditionally, a recurrence on c to make c-a-b > 0 * * |x| > 1 is rejected. * * The parameters a, b, c are considered to be integer * valued if they are within 1.0e-14 of the nearest integer * (1.0e-13 for IEEE arithmetic). * * ACCURACY: * * * Relative error (-1 < x < 1): * arithmetic domain # trials peak rms * IEEE -1,7 230000 1.2e-11 5.2e-14 * * Several special cases also tested with a, b, c in * the range -7 to 7. * * ERROR MESSAGES: * * A "partial loss of precision" message is printed if * the internally estimated relative error exceeds 1^-12. * A "singularity" message is printed on overflow or * in cases not addressed (such as x < -1). */ /* hyp2f1 */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1992, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef DEC #define EPS 1.0e-14 #define EPS2 1.0e-11 #endif #ifdef IBMPC #define EPS 1.0e-13 #define EPS2 1.0e-10 #endif #ifdef MIEEE #define EPS 1.0e-13 #define EPS2 1.0e-10 #endif #ifdef UNK #define EPS 1.0e-13 #define EPS2 1.0e-10 #endif #define ETHRESH 1.0e-12 #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_pow ( double, double ); extern double md_round ( double ); extern double md_gamma ( double ); extern double md_log ( double ); extern double md_exp ( double ); extern double psi ( double ); static double hyt2f1(double, double, double, double, double *); static double hys2f1(double, double, double, double, double *); double hyp2f1(double, double, double, double); #else double md_fabs(), md_pow(), md_round(), md_gamma(), md_log(), md_exp(), psi(); static double hyt2f1(); static double hys2f1(); double hyp2f1(); #endif extern double MAXNUM, MACHEP; double hyp2f1( a, b, c, x ) double a, b, c, x; { double d, d1, d2, e; double p, q, r, s, y, ax; double ia, ib, ic, id, err; int flag, i, aid; err = 0.0; ax = md_fabs(x); s = 1.0 - x; flag = 0; ia = md_round(a); /* nearest integer to a */ ib = md_round(b); if( a <= 0 ) { if( md_fabs(a-ia) < EPS ) /* a is a negative integer */ flag |= 1; } if( b <= 0 ) { if( md_fabs(b-ib) < EPS ) /* b is a negative integer */ flag |= 2; } if( ax < 1.0 ) { if( md_fabs(b-c) < EPS ) /* b = c */ { y = md_pow( s, -a ); /* s to the -a power */ goto hypdon; } if( md_fabs(a-c) < EPS ) /* a = c */ { y = md_pow( s, -b ); /* s to the -b power */ goto hypdon; } } if( c <= 0.0 ) { ic = md_round(c); /* nearest integer to c */ if( md_fabs(c-ic) < EPS ) /* c is a negative integer */ { /* check if termination before explosion */ if( (flag & 1) && (ia > ic) ) goto hypok; if( (flag & 2) && (ib > ic) ) goto hypok; goto hypdiv; } } if( flag ) /* function is a polynomial */ goto hypok; if( ax > 1.0 ) /* series diverges */ goto hypdiv; p = c - a; ia = md_round(p); /* nearest integer to c-a */ if( (ia <= 0.0) && (md_fabs(p-ia) < EPS) ) /* negative int c - a */ flag |= 4; r = c - b; ib = md_round(r); /* nearest integer to c-b */ if( (ib <= 0.0) && (md_fabs(r-ib) < EPS) ) /* negative int c - b */ flag |= 8; d = c - a - b; id = md_round(d); /* nearest integer to d */ q = md_fabs(d-id); /* Thanks to Christian Burger * for reporting a bug here. */ if( md_fabs(ax-1.0) < EPS ) /* |x| == 1.0 */ { if( x > 0.0 ) { if( flag & 12 ) /* negative int c-a or c-b */ { if( d >= 0.0 ) goto hypf; else goto hypdiv; } if( d <= 0.0 ) goto hypdiv; y = md_gamma(c)*md_gamma(d)/(md_gamma(p)*md_gamma(r)); goto hypdon; } if( d <= -1.0 ) goto hypdiv; } /* Conditionally make d > 0 by recurrence on c * AMS55 #15.2.27 */ if( d < 0.0 ) { /* Try the power series first */ y = hyt2f1( a, b, c, x, &err ); if( err < ETHRESH ) goto hypdon; /* Apply the recurrence if power series fails */ err = 0.0; aid = 2 - id; e = c + aid; d2 = hyp2f1(a,b,e,x); d1 = hyp2f1(a,b,e+1.0,x); q = a + b + 1.0; for( i=0; i ETHRESH ) { mtherr( "hyp2f1", PLOSS ); /* printf( "Estimated err = %.2e\n", err ); */ } return(y); /* The transformation for c-a or c-b negative integer * AMS55 #15.3.3 */ hypf: y = md_pow( s, d ) * hys2f1( c-a, c-b, c, x, &err ); goto hypdon; /* The alarm exit */ hypdiv: mtherr( "hyp2f1", OVERFLOW ); return( MAXNUM ); } /* Apply transformations for |x| near 1 * then call the power series */ static double hyt2f1( a, b, c, x, loss ) double a, b, c, x; double *loss; { double p, q, r, s, t, y, d, err, err1; double ax, id, d1, d2, e, md_y1; int i, aid; err = 0.0; s = 1.0 - x; if( x < -0.5 ) { if( b > a ) y = md_pow( s, -a ) * hys2f1( a, c-b, c, -x/s, &err ); else y = md_pow( s, -b ) * hys2f1( c-a, b, c, -x/s, &err ); goto done; } d = c - a - b; id = md_round(d); /* nearest integer to d */ if( x > 0.9 ) { if( md_fabs(d-id) > EPS ) /* test for integer c-a-b */ { /* Try the power series first */ y = hys2f1( a, b, c, x, &err ); if( err < ETHRESH ) goto done; /* If power series fails, then apply AMS55 #15.3.6 */ q = hys2f1( a, b, 1.0-d, s, &err ); q *= md_gamma(d) /(md_gamma(c-a) * md_gamma(c-b)); r = md_pow(s,d) * hys2f1( c-a, c-b, d+1.0, s, &err1 ); r *= md_gamma(-d)/(md_gamma(a) * md_gamma(b)); y = q + r; q = md_fabs(q); /* estimate cancellation error */ r = md_fabs(r); if( q > r ) r = q; err += err1 + (MACHEP*r)/y; y *= md_gamma(c); goto done; } else { /* Psi function expansion, AMS55 #15.3.10, #15.3.11, #15.3.12 */ if( id >= 0.0 ) { e = d; d1 = d; d2 = 0.0; aid = id; } else { e = -d; d1 = 0.0; d2 = d; aid = -id; } ax = md_log(s); /* sum for t = 0 */ y = psi(1.0) + psi(1.0+e) - psi(a+d1) - psi(b+d1) - ax; y /= md_gamma(e+1.0); p = (a+d1) * (b+d1) * s / md_gamma(e+2.0); /* Poch for t=1 */ t = 1.0; do { r = psi(1.0+t) + psi(1.0+t+e) - psi(a+t+d1) - psi(b+t+d1) - ax; q = p * r; y += q; p *= s * (a+t+d1) / (t+1.0); p *= (b+t+d1) / (t+1.0+e); t += 1.0; } while( md_fabs(q/y) > EPS ); if( id == 0.0 ) { y *= md_gamma(c)/(md_gamma(a)*md_gamma(b)); goto psidon; } md_y1 = 1.0; if( aid == 1 ) goto nosum; t = 0.0; p = 1.0; for( i=1; i 0.0 ) y *= q; else md_y1 *= q; y += md_y1; psidon: goto done; } } /* Use defining power series if no special cases */ y = hys2f1( a, b, c, x, &err ); done: *loss = err; return(y); } /* Defining power series expansion of Gauss hypergeometric function */ static double hys2f1( a, b, c, x, loss ) double a, b, c, x; double *loss; /* estimates loss of significance */ { double f, g, h, k, m, s, u, umax; int i; i = 0; umax = 0.0; f = a; g = b; h = c; s = 1.0; u = 1.0; k = 0.0; do { if( md_fabs(h) < EPS ) { *loss = 1.0; return( MAXNUM ); } m = k + 1.0; u = u * ((f+k) * (g+k) * x / ((h+k) * m)); s += u; k = md_fabs(u); /* remember largest term summed */ if( k > umax ) umax = k; k = m; if( ++i > 10000 ) /* should never happen */ { *loss = 1.0; return(s); } } while( md_fabs(u/s) > MACHEP ); /* return estimated relative error */ *loss = (MACHEP*umax)/md_fabs(s) + (MACHEP*i); return(s); } Math-Cephes-0.5306/libmd/log10.c0000644000175000017500000001210214757021403015745 0ustar shlomifshlomif/* md_log10.c * * Common logarithm * * * * SYNOPSIS: * * double x, y, md_log10(); * * y = md_log10( x ); * * * * DESCRIPTION: * * Returns logarithm to the base 10 of x. * * The argument is separated into its exponent and fractional * parts. The logarithm of the fraction is approximated by * * md_log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0.5, 2.0 30000 1.5e-16 5.0e-17 * IEEE 0, MAXNUM 30000 1.4e-16 4.8e-17 * DEC 1, MAXNUM 50000 2.5e-17 6.0e-18 * * In the tests over the interval [1, MAXNUM], the logarithms * of the random arguments were uniformly distributed over * [0, MAXLOG]. * * ERROR MESSAGES: * * md_log10 singularity: x = 0; returns -INFINITY * md_log10 domain: x < 0; returns NAN */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" static char fname[] = {"md_log10"}; /* Coefficients for md_log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) * 1/sqrt(2) <= x < sqrt(2) */ #ifdef UNK static double P[] = { 4.58482948458143443514E-5, 4.98531067254050724270E-1, 6.56312093769992875930E0, 2.97877425097986925891E1, 6.06127134467767258030E1, 5.67349287391754285487E1, 1.98892446572874072159E1 }; static double Q[] = { /* 1.00000000000000000000E0, */ 1.50314182634250003249E1, 8.27410449222435217021E1, 2.20664384982121929218E2, 3.07254189979530058263E2, 2.14955586696422947765E2, 5.96677339718622216300E1 }; #endif #ifdef DEC static unsigned short P[] = { 0034500,0046473,0051374,0135174, 0037777,0037566,0145712,0150321, 0040722,0002426,0031543,0123107, 0041356,0046513,0170752,0004346, 0041562,0071553,0023536,0163343, 0041542,0170221,0024316,0114216, 0041237,0016454,0046611,0104602 }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0041160,0100260,0067736,0102424, 0041645,0075552,0036563,0147072, 0042134,0125025,0021132,0025320, 0042231,0120211,0046030,0103271, 0042126,0172241,0052151,0120426, 0041556,0125702,0072116,0047103 }; #endif #ifdef IBMPC static unsigned short P[] = { 0x974f,0x6a5f,0x09a7,0x3f08, 0x5a1a,0xd979,0xe7ee,0x3fdf, 0x74c9,0xc66c,0x40a2,0x401a, 0x411d,0x7e3d,0xc9a9,0x403d, 0xdcdc,0x64eb,0x4e6d,0x404e, 0xd312,0x2519,0x5e12,0x404c, 0x3130,0x89b1,0xe3a5,0x4033 }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xd0a2,0x0dfb,0x1016,0x402e, 0x79c7,0x47ae,0xaf6d,0x4054, 0x455a,0xa44b,0x9542,0x406b, 0x10d7,0x2983,0x3411,0x4073, 0x3423,0x2a8d,0xde94,0x406a, 0xc9c8,0x4e89,0xd578,0x404d }; #endif #ifdef MIEEE static unsigned short P[] = { 0x3f08,0x09a7,0x6a5f,0x974f, 0x3fdf,0xe7ee,0xd979,0x5a1a, 0x401a,0x40a2,0xc66c,0x74c9, 0x403d,0xc9a9,0x7e3d,0x411d, 0x404e,0x4e6d,0x64eb,0xdcdc, 0x404c,0x5e12,0x2519,0xd312, 0x4033,0xe3a5,0x89b1,0x3130 }; static unsigned short Q[] = { 0x402e,0x1016,0x0dfb,0xd0a2, 0x4054,0xaf6d,0x47ae,0x79c7, 0x406b,0x9542,0xa44b,0x455a, 0x4073,0x3411,0x2983,0x10d7, 0x406a,0xde94,0x2a8d,0x3423, 0x404d,0xd578,0x4e89,0xc9c8 }; #endif #define SQRTH 0.70710678118654752440 #define L102A 3.0078125E-1 #define L102B 2.48745663981195213739E-4 #define L10EA 4.3359375E-1 #define L10EB 7.00731903251827651129E-4 #ifdef ANSIPROT extern double md_frexp ( double, int * ); extern double md_ldexp ( double, int ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern int isnan ( double ); extern int isfinite ( double ); #else double md_frexp(), md_ldexp(), polevl(), p1evl(); int isnan(), isfinite(); #endif extern double LOGE2, SQRT2, INFINITY, NAN; double md_log10(x) double x; { VOLATILE double z; double y; #ifdef DEC short *q; #endif int e; #ifdef NANS if( isnan(x) ) return(x); #endif #ifdef INFINITIES if( x == INFINITY ) return(x); #endif /* Test for domain */ if( x <= 0.0 ) { if( x == 0.0 ) { mtherr( fname, SING ); return( -INFINITY ); } else { mtherr( fname, DOMAIN ); return( NAN ); } } /* separate mantissa from exponent */ #ifdef DEC q = (short *)&x; e = *q; /* short containing exponent */ e = ((e >> 7) & 0377) - 0200; /* the exponent */ *q &= 0177; /* strip exponent from x */ *q |= 040000; /* x now between 0.5 and 1 */ #endif #ifdef IBMPC x = md_frexp( x, &e ); /* q = (short *)&x; q += 3; e = *q; e = ((e >> 4) & 0x0fff) - 0x3fe; *q &= 0x0f; *q |= 0x3fe0; */ #endif /* Equivalent C language standard library function: */ #ifdef UNK x = md_frexp( x, &e ); #endif #ifdef MIEEE x = md_frexp( x, &e ); #endif /* logarithm using md_log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if( x < SQRTH ) { e -= 1; x = md_ldexp( x, 1 ) - 1.0; /* 2x - 1 */ } else { x = x - 1.0; } /* rational form */ z = x*x; y = x * ( z * polevl( x, P, 6 ) / p1evl( x, Q, 6 ) ); y = y - md_ldexp( z, -1 ); /* y - 0.5 * x**2 */ /* multiply md_log of fraction by md_log10(e) * and base 2 exponent by md_log10(2) */ z = (x + y) * L10EB; /* accumulate terms in order of size */ z += y * L10EA; z += x * L10EA; z += e * L102B; z += e * L102A; return( z ); } Math-Cephes-0.5306/libmd/tandg.c0000644000175000017500000001126414757021403016130 0ustar shlomifshlomif/* tandg.c * * Circular tangent of argument in degrees * * * * SYNOPSIS: * * double x, y, tandg(); * * y = tandg( x ); * * * * DESCRIPTION: * * Returns the circular tangent of the argument x in degrees. * * Range reduction is modulo pi/4. A rational function * x + x**3 P(x**2)/Q(x**2) * is employed in the basic interval [0, pi/4]. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 0,10 8000 3.4e-17 1.2e-17 * IEEE 0,10 30000 3.2e-16 8.4e-17 * * ERROR MESSAGES: * * message condition value returned * tandg total loss x > 8.0e14 (DEC) 0.0 * x > 1.0e14 (IEEE) * tandg singularity x = 180 k + 90 MAXNUM */ /* cotdg.c * * Circular cotangent of argument in degrees * * * * SYNOPSIS: * * double x, y, cotdg(); * * y = cotdg( x ); * * * * DESCRIPTION: * * Returns the circular cotangent of the argument x in degrees. * * Range reduction is modulo pi/4. A rational function * x + x**3 P(x**2)/Q(x**2) * is employed in the basic interval [0, pi/4]. * * * ERROR MESSAGES: * * message condition value returned * cotdg total loss x > 8.0e14 (DEC) 0.0 * x > 1.0e14 (IEEE) * cotdg singularity x = 180 k MAXNUM */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double P[] = { -1.30936939181383777646E4, 1.15351664838587416140E6, -1.79565251976484877988E7 }; static double Q[] = { /* 1.00000000000000000000E0,*/ 1.36812963470692954678E4, -1.32089234440210967447E6, 2.50083801823357915839E7, -5.38695755929454629881E7 }; static double PI180 = 1.74532925199432957692E-2; static double lossth = 1.0e14; #endif #ifdef DEC static unsigned short P[] = { 0143514,0113306,0111171,0174674, 0045214,0147545,0027744,0167346, 0146210,0177526,0114514,0105660 }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0043525,0142457,0072633,0025617, 0145241,0036742,0140525,0162256, 0046276,0146176,0013526,0143573, 0146515,0077401,0162762,0150607 }; static unsigned short P1[] = {0036616,0175065,0011224,0164711}; #define PI180 *(double *)P1 static double lossth = 8.0e14; #endif #ifdef IBMPC static unsigned short P[] = { 0x3f38,0xd24f,0x92d8,0xc0c9, 0x9ddd,0xa5fc,0x99ec,0x4131, 0x9176,0xd329,0x1fea,0xc171 }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x6572,0xeeb3,0xb8a5,0x40ca, 0xbc96,0x582a,0x27bc,0xc134, 0xd8ef,0xc2ea,0xd98f,0x4177, 0x5a31,0x3cbe,0xafe0,0xc189 }; static unsigned short P1[] = {0x9d39,0xa252,0xdf46,0x3f91}; #define PI180 *(double *)P1 static double lossth = 1.0e14; #endif #ifdef MIEEE static unsigned short P[] = { 0xc0c9,0x92d8,0xd24f,0x3f38, 0x4131,0x99ec,0xa5fc,0x9ddd, 0xc171,0x1fea,0xd329,0x9176 }; static unsigned short Q[] = { 0x40ca,0xb8a5,0xeeb3,0x6572, 0xc134,0x27bc,0x582a,0xbc96, 0x4177,0xd98f,0xc2ea,0xd8ef, 0xc189,0xafe0,0x3cbe,0x5a31 }; static unsigned short P1[] = { 0x3f91,0xdf46,0xa252,0x9d39 }; #define PI180 *(double *)P1 static double lossth = 1.0e14; #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_floor ( double ); extern double md_ldexp ( double, int ); static double tancot( double, int ); #else double polevl(), p1evl(), md_floor(), md_ldexp(); static double tancot(); #endif extern double MAXNUM; extern double PIO4; double tandg(x) double x; { return( tancot(x,0) ); } double cotdg(x) double x; { return( tancot(x,1) ); } static double tancot( xx, cotflg ) double xx; int cotflg; { double x, y, z, zz; int j, sign; /* make argument positive but save the sign */ if( xx < 0 ) { x = -xx; sign = -1; } else { x = xx; sign = 1; } if( x > lossth ) { mtherr( "tandg", TLOSS ); return(0.0); } /* compute x mod PIO4 */ y = md_floor( x/45.0 ); /* strip high bits of integer part */ z = md_ldexp( y, -3 ); z = md_floor(z); /* integer part of y/8 */ z = y - md_ldexp( z, 3 ); /* y - 16 * (y/16) */ /* integer and fractional part modulo one octant */ j = z; /* map zeros and singularities to origin */ if( j & 1 ) { j += 1; y += 1.0; } z = x - y * 45.0; z *= PI180; zz = z * z; if( zz > 1.0e-14 ) y = z + z * (zz * polevl( zz, P, 2 )/p1evl(zz, Q, 4)); else y = z; if( j & 2 ) { if( cotflg ) y = -y; else { if( y != 0.0 ) { y = -1.0/y; } else { mtherr( "tandg", SING ); y = MAXNUM; } } } else { if( cotflg ) { if( y != 0.0 ) y = 1.0/y; else { mtherr( "cotdg", SING ); y = MAXNUM; } } } if( sign < 0 ) y = -y; return( y ); } Math-Cephes-0.5306/libmd/Makefile.PL0000644000175000017500000000427214757022177016653 0ustar shlomifshlomif# See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. use strict; use ExtUtils::MakeMaker; use Config; use File::Copy; my $arch = $Config{archname}; my $is_win32 = ($arch =~ /MSWin32/i && $Config{cc} eq 'cl'); my $is_387 = ($arch =~ /^i\d+-linux/i); my $is_sol = ($arch =~ /sun4-solaris|sparc/i); my $is_dar = ($arch =~ /darwin/i); my $is_cyg = ($arch =~ /cygwin/i || ($arch =~ /MSWin32/i && !$is_win32)); my $is_vms = ($arch =~ /vms/i); unless ($is_387) { my $from = $is_win32 ? 'setpmsvc.c.win32' : 'setprec.c.unix'; my $to = 'setprec.c'; unless (-e $to) { copy($from, $to) or die "Cannot copy $from to $to: $!"; } } unless ($is_387 or $is_sol) { my $from = 'sqrt.c.src'; my $to = 'sqrt.c'; unless (-e $to) { copy($from, $to) or die "Cannot copy $from to $to: $!"; } } opendir(DIR, '.') or die "Cannot opendir '.': $!\n"; my @objs = map {s/\.c$/.o/; $_} grep { /\.c$/ } sort readdir DIR; closedir DIR; my %objs = map {$_ => 1} @objs; foreach (qw(setprec.o sqrt.o)) { push @objs, $_ unless $objs{$_}; } my %opts = ( NAME => 'Math::Cephes::libmd', VERSION_FROM => '../lib/Math/Cephes.pm', # finds $VERSION OBJECT => join(' ', @objs), SKIP => [ qw( dynamic test ) ] , LINKTYPE => 'static', clean => {FILES => 'libmd$(LIB_EXT)'}, ); $opts{CCFLAGS} = $Config{ccflags} . ' -Wall -fno-builtin ' if $Config{gccversion}; WriteMakefile(%opts); package MY; sub c_o { my $self = shift; my $c_o = $self->SUPER::c_o(@_); if ($is_387) { $c_o .= << 'END'; sqrt.o: sqrtelf.387 $(AS) -o sqrt.o sqrtelf.387 setprec.o: setprelf.387 $(AS) -o setprec.o setprelf.387 END } elsif ($is_sol) { $c_o .= << 'END'; sqrt.o: sqrt.spa $(AS) -o sqrt.o sqrt.spa END } else { } return $c_o; } sub post_constants { my $postconstant = <<'END'; INST_STATIC = libmd$(LIB_EXT) END return $postconstant; } sub top_targets { my $top_targets = <<'END'; all :: static @$(NOOP) static :: libmd$(LIB_EXT) @$(NOOP) config :: test : test_static : test_dynamic : END return $top_targets; } Math-Cephes-0.5306/libmd/ellpj.c0000644000175000017500000000673014757021403016143 0ustar shlomifshlomif/* ellpj.c * * Jacobian Elliptic Functions * * * * SYNOPSIS: * * double u, m, sn, cn, dn, phi; * int ellpj(); * * ellpj( u, m, _&sn, _&cn, _&dn, _&phi ); * * * * DESCRIPTION: * * * Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m), * and dn(u|m) of parameter m between 0 and 1, and real * argument u. * * These functions are periodic, with quarter-period on the * real axis equal to the complete elliptic integral * ellpk(1.0-m). * * Relation to incomplete elliptic integral: * If u = ellik(phi,m), then sn(u|m) = md_sin(phi), * and cn(u|m) = md_cos(phi). Phi is called the amplitude of u. * * Computation is by means of the arithmetic-geometric mean * algorithm, except when m is within 1e-9 of 0 or 1. In the * latter case with m close to 1, the approximation applies * only for phi < pi/2. * * ACCURACY: * * Tested at random points with u between 0 and 10, m between * 0 and 1. * * Absolute error (* = relative error): * arithmetic function # trials peak rms * DEC sn 1800 4.5e-16 8.7e-17 * IEEE phi 10000 9.2e-16* 1.4e-16* * IEEE sn 50000 4.1e-15 4.6e-16 * IEEE cn 40000 3.6e-15 4.4e-16 * IEEE dn 10000 1.3e-12 1.8e-14 * * Peak error observed in consistency check using addition * theorem for sn(u+v) was 4e-16 (absolute). Also tested by * the above relation to the incomplete elliptic integral. * Accuracy deteriorates when u is large. * */ /* ellpj.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double sqrt ( double ); extern double md_fabs ( double ); extern double md_sin ( double ); extern double md_cos ( double ); extern double md_asin ( double ); extern double md_tanh ( double ); extern double md_sinh ( double ); extern double md_cosh ( double ); extern double md_atan ( double ); extern double md_exp ( double ); #else double sqrt(), md_fabs(), md_sin(), md_cos(), md_asin(), md_tanh(); double md_sinh(), md_cosh(), md_atan(), md_exp(); #endif extern double PIO2, MACHEP; int ellpj( u, m, sn, cn, dn, ph ) double u, m; double *sn, *cn, *dn, *ph; { double ai, b, phi, t, twon; double a[9], c[9]; int i; /* Check for special cases */ if( m < 0.0 || m > 1.0 ) { mtherr( "ellpj", DOMAIN ); *sn = 0.0; *cn = 0.0; *ph = 0.0; *dn = 0.0; return(-1); } if( m < 1.0e-9 ) { t = md_sin(u); b = md_cos(u); ai = 0.25 * m * (u - t*b); *sn = t - ai*b; *cn = b + ai*t; *ph = u - ai; *dn = 1.0 - 0.5*m*t*t; return(0); } if( m >= 0.9999999999 ) { ai = 0.25 * (1.0-m); b = md_cosh(u); t = md_tanh(u); phi = 1.0/b; twon = b * md_sinh(u); *sn = t + ai * (twon - u)/(b*b); *ph = 2.0*md_atan(md_exp(u)) - PIO2 + ai*(twon - u)/b; ai *= t * phi; *cn = phi - ai * (twon - u); *dn = phi + ai * (twon + u); return(0); } /* A. G. M. scale */ a[0] = 1.0; b = sqrt(1.0 - m); c[0] = sqrt(m); twon = 1.0; i = 0; while( md_fabs(c[i]/a[i]) > MACHEP ) { if( i > 7 ) { mtherr( "ellpj", OVERFLOW ); goto done; } ai = a[i]; ++i; c[i] = ( ai - b )/2.0; t = sqrt( ai * b ); a[i] = ( ai + b )/2.0; b = t; twon *= 2.0; } done: /* backward recurrence */ phi = twon * a[i] * u; do { t = c[i] * md_sin(phi) / a[i]; b = phi; phi = (md_asin(t) + phi)/2.0; } while( --i ); *sn = md_sin(phi); t = md_cos(phi); *cn = t; *dn = t/md_cos(phi-b); *ph = phi; return(0); } Math-Cephes-0.5306/libmd/polyn.c0000644000175000017500000001743714757021403016204 0ustar shlomifshlomif/* polyn.c * polyr.c * Arithmetic operations on polynomials * * In the following descriptions a, b, c are polynomials of degree * na, nb, nc respectively. The degree of a polynomial cannot * exceed a run-time value MAXPOL. An operation that attempts * to use or generate a polynomial of higher degree may produce a * result that suffers truncation at degree MAXPOL. The value of * MAXPOL is set by calling the function * * polini( maxpol ); * * where maxpol is the desired maximum degree. This must be * done prior to calling any of the other functions in this module. * Memory for internal temporary polynomial storage is allocated * by polini(). * * Each polynomial is represented by an array containing its * coefficients, together with a separately declared integer equal * to the degree of the polynomial. The coefficients appear in * ascending order; that is, * * 2 na * a(x) = a[0] + a[1] * x + a[2] * x + ... + a[na] * x . * * * * sum = poleva( a, na, x ); Evaluate polynomial a(t) at t = x. * polprt( a, na, D ); Print the coefficients of a to D digits. * polclr( a, na ); Set a identically equal to zero, up to a[na]. * polmov( a, na, b ); Set b = a. * poladd( a, na, b, nb, c ); c = b + a, nc = max(na,nb) * polsub( a, na, b, nb, c ); c = b - a, nc = max(na,nb) * polmul( a, na, b, nb, c ); c = b * a, nc = na+nb * * * Division: * * i = poldiv( a, na, b, nb, c ); c = b / a, nc = MAXPOL * * returns i = the degree of the first nonzero coefficient of a. * The computed quotient c must be divided by x^i. An error message * is printed if a is identically zero. * * * Change of variables: * If a and b are polynomials, and t = a(x), then * c(t) = b(a(x)) * is a polynomial found by substituting a(x) for t. The * subroutine call for this is * * polsbt( a, na, b, nb, c ); * * * Notes: * poldiv() is an integer routine; poleva() is double. * Any of the arguments a, b, c may refer to the same array. * */ #include #include "mconf.h" #ifdef ANSIPROT void exit (int); extern void * malloc ( long ); extern void free ( void * ); void polclr ( double *, int ); void polmov ( double *, int, double * ); void polmul ( double *, int, double *, int, double * ); int poldiv ( double *, int, double *, int, double * ); #else void exit(); void * malloc(); void free (); void polclr(), polmov(), polmul(); int poldiv(); #endif #ifndef NULL #define NULL 0 #endif /* near pointer version of malloc() */ /* #define malloc _nmalloc #define free _nfree */ /* Pointers to internal arrays. Note poldiv() allocates * and deallocates some temporary arrays every time it is called. */ static double *pt1 = 0; static double *pt2 = 0; static double *pt3 = 0; /* Maximum degree of polynomial. */ int MAXPOL = 0; extern int MAXPOL; /* Number of bytes (chars) in maximum size polynomial. */ static int psize = 0; /* Initialize max degree of polynomials * and allocate temporary storage. */ void polini( maxdeg ) int maxdeg; { MAXPOL = maxdeg; psize = (maxdeg + 1) * sizeof(double); /* Release previously allocated memory, if any. */ if( pt3 ) free(pt3); if( pt2 ) free(pt2); if( pt1 ) free(pt1); /* Allocate new arrays */ pt1 = (double * )malloc(psize); /* used by polsbt */ pt2 = (double * )malloc(psize); /* used by polsbt */ pt3 = (double * )malloc(psize); /* used by polmul */ /* Report if failure */ if( (pt1 == NULL) || (pt2 == NULL) || (pt3 == NULL) ) { mtherr( "polini", ERANGE ); exit(1); } } /* Print the coefficients of a, with d decimal precision. */ static char *form = "abcdefghijk"; void polprt( a, na, d ) double a[]; int na, d; { int i, j, d1; char *p; /* Create format descriptor string for the printout. * Do this partly by hand, since sprintf() may be too * bug-ridden to accomplish this feat by itself. */ p = form; *p++ = '%'; d1 = d + 8; sprintf( p, "%d ", d1 ); p += 1; if( d1 >= 10 ) p += 1; *p++ = '.'; sprintf( p, "%d ", d ); p += 1; if( d >= 10 ) p += 1; *p++ = 'e'; *p++ = ' '; *p++ = '\0'; /* Now do the printing. */ d1 += 1; j = 0; for( i=0; i<=na; i++ ) { /* Detect end of available line */ j += d1; if( j >= 78 ) { printf( "\n" ); j = d1; } printf( form, a[i] ); } printf( "\n" ); } /* Set a = 0. */ void polclr( a, n ) register double *a; int n; { int i; if( n > MAXPOL ) n = MAXPOL; for( i=0; i<=n; i++ ) *a++ = 0.0; } /* Set b = a. */ void polmov( a, na, b ) register double *a, *b; int na; { int i; if( na > MAXPOL ) na = MAXPOL; for( i=0; i<= na; i++ ) { *b++ = *a++; } } /* c = b * a. */ void polmul( a, na, b, nb, c ) double a[], b[], c[]; int na, nb; { int i, j, k, nc; double x; nc = na + nb; polclr( pt3, MAXPOL ); for( i=0; i<=na; i++ ) { x = a[i]; for( j=0; j<=nb; j++ ) { k = i + j; if( k > MAXPOL ) break; pt3[k] += x * b[j]; } } if( nc > MAXPOL ) nc = MAXPOL; for( i=0; i<=nc; i++ ) c[i] = pt3[i]; } /* c = b + a. */ void poladd( a, na, b, nb, c ) double a[], b[], c[]; int na, nb; { int i, n; if( na > nb ) n = na; else n = nb; if( n > MAXPOL ) n = MAXPOL; for( i=0; i<=n; i++ ) { if( i > na ) c[i] = b[i]; else if( i > nb ) c[i] = a[i]; else c[i] = b[i] + a[i]; } } /* c = b - a. */ void polsub( a, na, b, nb, c ) double a[], b[], c[]; int na, nb; { int i, n; if( na > nb ) n = na; else n = nb; if( n > MAXPOL ) n = MAXPOL; for( i=0; i<=n; i++ ) { if( i > na ) c[i] = b[i]; else if( i > nb ) c[i] = -a[i]; else c[i] = b[i] - a[i]; } } /* c = b/a */ int poldiv( a, na, b, nb, c ) double a[], b[], c[]; int na, nb; { double quot; double *ta, *tb, *tq; int i, j, k, sing; sing = 0; /* Allocate temporary arrays. This would be quicker * if done automatically on the stack, but stack space * may be hard to obtain on a small computer. */ ta = (double * )malloc( psize ); polclr( ta, MAXPOL ); polmov( a, na, ta ); tb = (double * )malloc( psize ); polclr( tb, MAXPOL ); polmov( b, nb, tb ); tq = (double * )malloc( psize ); polclr( tq, MAXPOL ); /* What to do if leading (constant) coefficient * of denominator is zero. */ if( a[0] == 0.0 ) { for( i=0; i<=na; i++ ) { if( ta[i] != 0.0 ) goto nzero; } mtherr( "poldiv", SING ); goto done; nzero: /* Reduce the degree of the denominator. */ for( i=0; i MAXPOL ) break; tb[k] -= quot * ta[j]; } tq[i] = quot; } /* Send quotient to output array. */ polmov( tq, MAXPOL, c ); done: /* Restore allocated memory. */ free(tq); free(tb); free(ta); return( sing ); } /* Change of variables * Substitute a(y) for the variable x in b(x). * x = a(y) * c(x) = b(x) = b(a(y)). */ void polsbt( a, na, b, nb, c ) double a[], b[], c[]; int na, nb; { int i, j, k, n2; double x; /* 0th degree term: */ polclr( pt1, MAXPOL ); pt1[0] = b[0]; polclr( pt2, MAXPOL ); pt2[0] = 1.0; n2 = 0; for( i=1; i<=nb; i++ ) { /* Form ith power of a. */ polmul( a, na, pt2, n2, pt2 ); n2 += na; x = b[i]; /* Add the ith coefficient of b times the ith power of a. */ for( j=0; j<=n2; j++ ) { if( j > MAXPOL ) break; pt1[j] += x * pt2[j]; } } k = n2 + nb; if( k > MAXPOL ) k = MAXPOL; for( i=0; i<=k; i++ ) c[i] = pt1[i]; } /* Evaluate polynomial a(t) at t = x. */ double poleva( a, na, x ) double a[]; int na; double x; { double s; int i; s = a[na]; for( i=na-1; i>=0; i-- ) { s = s * x + a[i]; } return(s); } Math-Cephes-0.5306/libmd/gamma.c0000644000175000017500000003360414757021403016117 0ustar shlomifshlomif/* md_gamma.c * * Gamma function * * * * SYNOPSIS: * * double x, y, md_gamma(); * extern int sgngam; * * y = md_gamma( x ); * * * * DESCRIPTION: * * Returns md_gamma function of the argument. The result is * correctly signed, and the sign (+1 or -1) is also * returned in a global (extern) variable named sgngam. * This variable is also filled in by the logarithmic md_gamma * function lgam(). * * Arguments |x| <= 34 are reduced by recurrence and the function * approximated by a rational function of degree 6/7 in the * interval (2,3). Large arguments are handled by Stirling's * formula. Large negative arguments are made positive using * a reflection formula. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -34, 34 10000 1.3e-16 2.5e-17 * IEEE -170,-33 20000 2.3e-15 3.3e-16 * IEEE -33, 33 20000 9.4e-16 2.2e-16 * IEEE 33, 171.6 20000 2.3e-15 3.2e-16 * * Error for arguments outside the test range will be larger * owing to error amplification by the exponential function. * */ /* lgam() * * Natural logarithm of md_gamma function * * * * SYNOPSIS: * * double x, y, lgam(); * extern int sgngam; * * y = lgam( x ); * * * * DESCRIPTION: * * Returns the base e (2.718...) logarithm of the absolute * value of the md_gamma function of the argument. * The sign (+1 or -1) of the md_gamma function is returned in a * global (extern) variable named sgngam. * * For arguments greater than 13, the logarithm of the md_gamma * function is approximated by the logarithmic version of * Stirling's formula using a polynomial approximation of * degree 4. Arguments between -33 and +33 are reduced by * recurrence to the interval [2,3] of a rational approximation. * The cosecant reflection formula is employed for arguments * less than -33. * * Arguments greater than MAXLGM return MAXNUM and an error * message. MAXLGM = 2.035093e36 for DEC * arithmetic or 2.556348e305 for IEEE arithmetic. * * * * ACCURACY: * * * arithmetic domain # trials peak rms * DEC 0, 3 7000 5.2e-17 1.3e-17 * DEC 2.718, 2.035e36 5000 3.9e-17 9.9e-18 * IEEE 0, 3 28000 5.4e-16 1.1e-16 * IEEE 2.718, 2.556e305 40000 3.5e-16 8.3e-17 * The error criterion was relative when the function magnitude * was greater than one but absolute when it was less than one. * * The following test used the relative error criterion, though * at certain points the relative error could be much higher than * indicated. * IEEE -200, -4 10000 4.8e-16 1.3e-16 * */ /* md_gamma.c */ /* md_gamma function */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double P[] = { 1.60119522476751861407E-4, 1.19135147006586384913E-3, 1.04213797561761569935E-2, 4.76367800457137231464E-2, 2.07448227648435975150E-1, 4.94214826801497100753E-1, 9.99999999999999996796E-1 }; static double Q[] = { -2.31581873324120129819E-5, 5.39605580493303397842E-4, -4.45641913851797240494E-3, 1.18139785222060435552E-2, 3.58236398605498653373E-2, -2.34591795718243348568E-1, 7.14304917030273074085E-2, 1.00000000000000000320E0 }; #define MAXGAM 171.624376956302725 static double LOGPI = 1.14472988584940017414; #endif #ifdef DEC static unsigned short P[] = { 0035047,0162701,0146301,0005234, 0035634,0023437,0032065,0176530, 0036452,0137157,0047330,0122574, 0037103,0017310,0143041,0017232, 0037524,0066516,0162563,0164605, 0037775,0004671,0146237,0014222, 0040200,0000000,0000000,0000000 }; static unsigned short Q[] = { 0134302,0041724,0020006,0116565, 0035415,0072121,0044251,0025634, 0136222,0003447,0035205,0121114, 0036501,0107552,0154335,0104271, 0037022,0135717,0014776,0171471, 0137560,0034324,0165024,0037021, 0037222,0045046,0047151,0161213, 0040200,0000000,0000000,0000000 }; #define MAXGAM 34.84425627277176174 static unsigned short LPI[4] = { 0040222,0103202,0043475,0006750, }; #define LOGPI *(double *)LPI #endif #ifdef IBMPC static unsigned short P[] = { 0x2153,0x3998,0xfcb8,0x3f24, 0xbfab,0xe686,0x84e3,0x3f53, 0x14b0,0xe9db,0x57cd,0x3f85, 0x23d3,0x18c4,0x63d9,0x3fa8, 0x7d31,0xdcae,0x8da9,0x3fca, 0xe312,0x3993,0xa137,0x3fdf, 0x0000,0x0000,0x0000,0x3ff0 }; static unsigned short Q[] = { 0xd3af,0x8400,0x487a,0xbef8, 0x2573,0x2915,0xae8a,0x3f41, 0xb44a,0xe750,0x40e4,0xbf72, 0xb117,0x5b1b,0x31ed,0x3f88, 0xde67,0xe33f,0x5779,0x3fa2, 0x87c2,0x9d42,0x071a,0xbfce, 0x3c51,0xc9cd,0x4944,0x3fb2, 0x0000,0x0000,0x0000,0x3ff0 }; #define MAXGAM 171.624376956302725 static unsigned short LPI[4] = { 0xa1bd,0x48e7,0x50d0,0x3ff2, }; #define LOGPI *(double *)LPI #endif #ifdef MIEEE static unsigned short P[] = { 0x3f24,0xfcb8,0x3998,0x2153, 0x3f53,0x84e3,0xe686,0xbfab, 0x3f85,0x57cd,0xe9db,0x14b0, 0x3fa8,0x63d9,0x18c4,0x23d3, 0x3fca,0x8da9,0xdcae,0x7d31, 0x3fdf,0xa137,0x3993,0xe312, 0x3ff0,0x0000,0x0000,0x0000 }; static unsigned short Q[] = { 0xbef8,0x487a,0x8400,0xd3af, 0x3f41,0xae8a,0x2915,0x2573, 0xbf72,0x40e4,0xe750,0xb44a, 0x3f88,0x31ed,0x5b1b,0xb117, 0x3fa2,0x5779,0xe33f,0xde67, 0xbfce,0x071a,0x9d42,0x87c2, 0x3fb2,0x4944,0xc9cd,0x3c51, 0x3ff0,0x0000,0x0000,0x0000 }; #define MAXGAM 171.624376956302725 static unsigned short LPI[4] = { 0x3ff2,0x50d0,0x48e7,0xa1bd, }; #define LOGPI *(double *)LPI #endif /* Stirling's formula for the md_gamma function */ #if UNK static double STIR[5] = { 7.87311395793093628397E-4, -2.29549961613378126380E-4, -2.68132617805781232825E-3, 3.47222221605458667310E-3, 8.33333333333482257126E-2, }; #define MAXSTIR 143.01608 static double SQTPI = 2.50662827463100050242E0; #endif #if DEC static unsigned short STIR[20] = { 0035516,0061622,0144553,0112224, 0135160,0131531,0037460,0165740, 0136057,0134460,0037242,0077270, 0036143,0107070,0156306,0027751, 0037252,0125252,0125252,0146064, }; #define MAXSTIR 26.77 static unsigned short SQT[4] = { 0040440,0066230,0177661,0034055, }; #define SQTPI *(double *)SQT #endif #if IBMPC static unsigned short STIR[20] = { 0x7293,0x592d,0xcc72,0x3f49, 0x1d7c,0x27e6,0x166b,0xbf2e, 0x4fd7,0x07d4,0xf726,0xbf65, 0xc5fd,0x1b98,0x71c7,0x3f6c, 0x5986,0x5555,0x5555,0x3fb5, }; #define MAXSTIR 143.01608 static unsigned short SQT[4] = { 0x2706,0x1ff6,0x0d93,0x4004, }; #define SQTPI *(double *)SQT #endif #if MIEEE static unsigned short STIR[20] = { 0x3f49,0xcc72,0x592d,0x7293, 0xbf2e,0x166b,0x27e6,0x1d7c, 0xbf65,0xf726,0x07d4,0x4fd7, 0x3f6c,0x71c7,0x1b98,0xc5fd, 0x3fb5,0x5555,0x5555,0x5986, }; #define MAXSTIR 143.01608 static unsigned short SQT[4] = { 0x4004,0x0d93,0x1ff6,0x2706, }; #define SQTPI *(double *)SQT #endif int sgngam = 0; extern int sgngam; extern double MAXLOG, MAXNUM, PI; #ifdef ANSIPROT extern double md_pow ( double, double ); extern double md_log ( double ); extern double md_exp ( double ); extern double md_sin ( double ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_floor ( double ); extern double md_fabs ( double ); extern int isnan ( double ); extern int isfinite ( double ); static double stirf ( double ); double lgam ( double ); #else double md_pow(), md_log(), md_exp(), md_sin(), polevl(), p1evl(), md_floor(), md_fabs(); int isnan(), isfinite(); static double stirf(); double lgam(); #endif #ifdef INFINITIES extern double INFINITY; #endif #ifdef NANS extern double NAN; #endif /* Gamma function computed by Stirling's formula. * The polynomial STIR is valid for 33 <= x <= 172. */ static double stirf(x) double x; { double y, w, v; w = 1.0/x; w = 1.0 + w * polevl( w, STIR, 4 ); y = md_exp(x); if( x > MAXSTIR ) { /* Avoid overflow in md_pow() */ v = md_pow( x, 0.5 * x - 0.25 ); y = v * (v / y); } else { y = md_pow( x, x - 0.5 ) / y; } y = SQTPI * y * w; return( y ); } double md_gamma(x) double x; { double p, q, z; int i; sgngam = 1; #ifdef NANS if( isnan(x) ) return(x); #endif #ifdef INFINITIES #ifdef NANS if( x == INFINITY ) return(x); if( x == -INFINITY ) return(NAN); #else if( !isfinite(x) ) return(x); #endif #endif q = md_fabs(x); if( q > 33.0 ) { if( x < 0.0 ) { p = md_floor(q); if( p == q ) { #ifdef NANS gamnan: mtherr( "md_gamma", DOMAIN ); return (NAN); #else goto goverf; #endif } i = p; if( (i & 1) == 0 ) sgngam = -1; z = q - p; if( z > 0.5 ) { p += 1.0; z = q - p; } z = q * md_sin( PI * z ); if( z == 0.0 ) { #ifdef INFINITIES return( sgngam * INFINITY); #else goverf: mtherr( "md_gamma", OVERFLOW ); return( sgngam * MAXNUM); #endif } z = md_fabs(z); z = PI/(z * stirf(q) ); } else { z = stirf(x); } return( sgngam * z ); } z = 1.0; while( x >= 3.0 ) { x -= 1.0; z *= x; } while( x < 0.0 ) { if( x > -1.E-9 ) goto small; z /= x; x += 1.0; } while( x < 2.0 ) { if( x < 1.e-9 ) goto small; z /= x; x += 1.0; } if( x == 2.0 ) return(z); x -= 2.0; p = polevl( x, P, 6 ); q = polevl( x, Q, 7 ); return( z * p / q ); small: if( x == 0.0 ) { #ifdef INFINITIES #ifdef NANS goto gamnan; #else return( INFINITY ); #endif #else mtherr( "md_gamma", SING ); return( MAXNUM ); #endif } else return( z/((1.0 + 0.5772156649015329 * x) * x) ); } /* A[]: Stirling's formula expansion of md_log md_gamma * B[], C[]: md_log md_gamma function between 2 and 3 */ #ifdef UNK static double A[] = { 8.11614167470508450300E-4, -5.95061904284301438324E-4, 7.93650340457716943945E-4, -2.77777777730099687205E-3, 8.33333333333331927722E-2 }; static double B[] = { -1.37825152569120859100E3, -3.88016315134637840924E4, -3.31612992738871184744E5, -1.16237097492762307383E6, -1.72173700820839662146E6, -8.53555664245765465627E5 }; static double C[] = { /* 1.00000000000000000000E0, */ -3.51815701436523470549E2, -1.70642106651881159223E4, -2.20528590553854454839E5, -1.13933444367982507207E6, -2.53252307177582951285E6, -2.01889141433532773231E6 }; /* md_log( sqrt( 2*pi ) ) */ static double LS2PI = 0.91893853320467274178; #define MAXLGM 2.556348e305 #endif #ifdef DEC static unsigned short A[] = { 0035524,0141201,0034633,0031405, 0135433,0176755,0126007,0045030, 0035520,0006371,0003342,0172730, 0136066,0005540,0132605,0026407, 0037252,0125252,0125252,0125132 }; static unsigned short B[] = { 0142654,0044014,0077633,0035410, 0144027,0110641,0125335,0144760, 0144641,0165637,0142204,0047447, 0145215,0162027,0146246,0155211, 0145322,0026110,0010317,0110130, 0145120,0061472,0120300,0025363 }; static unsigned short C[] = { /*0040200,0000000,0000000,0000000*/ 0142257,0164150,0163630,0112622, 0143605,0050153,0156116,0135272, 0144527,0056045,0145642,0062332, 0145213,0012063,0106250,0001025, 0145432,0111254,0044577,0115142, 0145366,0071133,0050217,0005122 }; /* md_log( sqrt( 2*pi ) ) */ static unsigned short LS2P[] = {040153,037616,041445,0172645,}; #define LS2PI *(double *)LS2P #define MAXLGM 2.035093e36 #endif #ifdef IBMPC static unsigned short A[] = { 0x6661,0x2733,0x9850,0x3f4a, 0xe943,0xb580,0x7fbd,0xbf43, 0x5ebb,0x20dc,0x019f,0x3f4a, 0xa5a1,0x16b0,0xc16c,0xbf66, 0x554b,0x5555,0x5555,0x3fb5 }; static unsigned short B[] = { 0x6761,0x8ff3,0x8901,0xc095, 0xb93e,0x355b,0xf234,0xc0e2, 0x89e5,0xf890,0x3d73,0xc114, 0xdb51,0xf994,0xbc82,0xc131, 0xf20b,0x0219,0x4589,0xc13a, 0x055e,0x5418,0x0c67,0xc12a }; static unsigned short C[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x12b2,0x1cf3,0xfd0d,0xc075, 0xd757,0x7b89,0xaa0d,0xc0d0, 0x4c9b,0xb974,0xeb84,0xc10a, 0x0043,0x7195,0x6286,0xc131, 0xf34c,0x892f,0x5255,0xc143, 0xe14a,0x6a11,0xce4b,0xc13e }; /* md_log( sqrt( 2*pi ) ) */ static unsigned short LS2P[] = { 0xbeb5,0xc864,0x67f1,0x3fed }; #define LS2PI *(double *)LS2P #define MAXLGM 2.556348e305 #endif #ifdef MIEEE static unsigned short A[] = { 0x3f4a,0x9850,0x2733,0x6661, 0xbf43,0x7fbd,0xb580,0xe943, 0x3f4a,0x019f,0x20dc,0x5ebb, 0xbf66,0xc16c,0x16b0,0xa5a1, 0x3fb5,0x5555,0x5555,0x554b }; static unsigned short B[] = { 0xc095,0x8901,0x8ff3,0x6761, 0xc0e2,0xf234,0x355b,0xb93e, 0xc114,0x3d73,0xf890,0x89e5, 0xc131,0xbc82,0xf994,0xdb51, 0xc13a,0x4589,0x0219,0xf20b, 0xc12a,0x0c67,0x5418,0x055e }; static unsigned short C[] = { 0xc075,0xfd0d,0x1cf3,0x12b2, 0xc0d0,0xaa0d,0x7b89,0xd757, 0xc10a,0xeb84,0xb974,0x4c9b, 0xc131,0x6286,0x7195,0x0043, 0xc143,0x5255,0x892f,0xf34c, 0xc13e,0xce4b,0x6a11,0xe14a }; /* md_log( sqrt( 2*pi ) ) */ static unsigned short LS2P[] = { 0x3fed,0x67f1,0xc864,0xbeb5 }; #define LS2PI *(double *)LS2P #define MAXLGM 2.556348e305 #endif /* Logarithm of md_gamma function */ double lgam(x) double x; { double p, q, u, w, z; int i; sgngam = 1; #ifdef NANS if( isnan(x) ) return(x); #endif #ifdef INFINITIES if( !isfinite(x) ) return(INFINITY); #endif if( x < -34.0 ) { q = -x; w = lgam(q); /* note this modifies sgngam! */ p = md_floor(q); if( p == q ) { lgsing: #ifdef INFINITIES mtherr( "lgam", SING ); return (INFINITY); #else goto loverf; #endif } i = p; if( (i & 1) == 0 ) sgngam = -1; else sgngam = 1; z = q - p; if( z > 0.5 ) { p += 1.0; z = p - q; } z = q * md_sin( PI * z ); if( z == 0.0 ) goto lgsing; /* z = md_log(PI) - md_log( z ) - w;*/ z = LOGPI - md_log( z ) - w; return( z ); } if( x < 13.0 ) { z = 1.0; p = 0.0; u = x; while( u >= 3.0 ) { p -= 1.0; u = x + p; z *= u; } while( u < 2.0 ) { if( u == 0.0 ) goto lgsing; z /= u; p += 1.0; u = x + p; } if( z < 0.0 ) { sgngam = -1; z = -z; } else sgngam = 1; if( u == 2.0 ) return( md_log(z) ); p -= 2.0; x = x + p; p = x * polevl( x, B, 5 ) / p1evl( x, C, 6); return( md_log(z) + p ); } if( x > MAXLGM ) { #ifdef INFINITIES return( sgngam * INFINITY ); #else loverf: mtherr( "lgam", OVERFLOW ); return( sgngam * MAXNUM ); #endif } q = ( x - 0.5 ) * md_log(x) - x + LS2PI; if( x > 1.0e8 ) return( q ); p = 1.0/(x*x); if( x >= 1000.0 ) q += (( 7.9365079365079365079365e-4 * p - 2.7777777777777777777778e-3) *p + 0.0833333333333333333333) / x; else q += polevl( p, A, 4 ) / x; return( q ); } Math-Cephes-0.5306/libmd/spence.c0000644000175000017500000000760014757021403016307 0ustar shlomifshlomif/* spence.c * * Dilogarithm * * * * SYNOPSIS: * * double x, y, spence(); * * y = spence( x ); * * * * DESCRIPTION: * * Computes the integral * * x * - * | | md_log t * spence(x) = - | ----- dt * | | t - 1 * - * 1 * * for x >= 0. A rational approximation gives the integral in * the interval (0.5, 1.5). Transformation formulas for 1/x * and 1-x are employed outside the basic expansion range. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0,4 30000 3.9e-15 5.4e-16 * DEC 0,4 3000 2.5e-16 4.5e-17 * * */ /* spence.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1985, 1987, 1989, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double A[8] = { 4.65128586073990045278E-5, 7.31589045238094711071E-3, 1.33847639578309018650E-1, 8.79691311754530315341E-1, 2.71149851196553469920E0, 4.25697156008121755724E0, 3.29771340985225106936E0, 1.00000000000000000126E0, }; static double B[8] = { 6.90990488912553276999E-4, 2.54043763932544379113E-2, 2.82974860602568089943E-1, 1.41172597751831069617E0, 3.63800533345137075418E0, 5.03278880143316990390E0, 3.54771340985225096217E0, 9.99999999999999998740E-1, }; #endif #ifdef DEC static unsigned short A[32] = { 0034503,0013315,0034120,0157771, 0036357,0135043,0016766,0150637, 0037411,0007533,0005212,0161475, 0040141,0031563,0023217,0120331, 0040455,0104461,0007002,0155522, 0040610,0034434,0065721,0120465, 0040523,0006674,0105671,0054427, 0040200,0000000,0000000,0000000, }; static unsigned short B[32] = { 0035465,0021626,0032367,0144157, 0036720,0016326,0134431,0000406, 0037620,0161024,0133701,0120766, 0040264,0131557,0152055,0064512, 0040550,0152424,0051166,0034272, 0040641,0006233,0014672,0111572, 0040543,0006674,0105671,0054425, 0040200,0000000,0000000,0000000, }; #endif #ifdef IBMPC static unsigned short A[32] = { 0x1bff,0xa70a,0x62d9,0x3f08, 0xda34,0x63be,0xf744,0x3f7d, 0x5c68,0x6151,0x21eb,0x3fc1, 0xf41b,0x64d1,0x266e,0x3fec, 0x5b6a,0x21c0,0xb126,0x4005, 0x3427,0x8d7a,0x0723,0x4011, 0x2b23,0x9177,0x61b7,0x400a, 0x0000,0x0000,0x0000,0x3ff0, }; static unsigned short B[32] = { 0xf90e,0xc69e,0xa472,0x3f46, 0x2021,0xd723,0x039a,0x3f9a, 0x343f,0x96f8,0x1c42,0x3fd2, 0xad29,0xfa85,0x966d,0x3ff6, 0xc717,0x8a4e,0x1aa2,0x400d, 0x526f,0x6337,0x2193,0x4014, 0x2b23,0x9177,0x61b7,0x400c, 0x0000,0x0000,0x0000,0x3ff0, }; #endif #ifdef MIEEE static unsigned short A[32] = { 0x3f08,0x62d9,0xa70a,0x1bff, 0x3f7d,0xf744,0x63be,0xda34, 0x3fc1,0x21eb,0x6151,0x5c68, 0x3fec,0x266e,0x64d1,0xf41b, 0x4005,0xb126,0x21c0,0x5b6a, 0x4011,0x0723,0x8d7a,0x3427, 0x400a,0x61b7,0x9177,0x2b23, 0x3ff0,0x0000,0x0000,0x0000, }; static unsigned short B[32] = { 0x3f46,0xa472,0xc69e,0xf90e, 0x3f9a,0x039a,0xd723,0x2021, 0x3fd2,0x1c42,0x96f8,0x343f, 0x3ff6,0x966d,0xfa85,0xad29, 0x400d,0x1aa2,0x8a4e,0xc717, 0x4014,0x2193,0x6337,0x526f, 0x400c,0x61b7,0x9177,0x2b23, 0x3ff0,0x0000,0x0000,0x0000, }; #endif #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_log ( double ); extern double polevl ( double, void *, int ); #else double md_fabs(), md_log(), polevl(); #endif extern double PI, MACHEP; double spence(x) double x; { double w, y, z; int flag; if( x < 0.0 ) { mtherr( "spence", DOMAIN ); return(0.0); } if( x == 1.0 ) return( 0.0 ); if( x == 0.0 ) return( PI*PI/6.0 ); flag = 0; if( x > 2.0 ) { x = 1.0/x; flag |= 2; } if( x > 1.5 ) { w = (1.0/x) - 1.0; flag |= 2; } else if( x < 0.5 ) { w = -x; flag |= 1; } else w = x - 1.0; y = -w * polevl( w, A, 7) / polevl( w, B, 7 ); if( flag & 1 ) y = (PI * PI)/6.0 - md_log(x) * md_log(1.0-x) - y; if( flag & 2 ) { z = md_log(x); y = -0.5 * z * z - y; } return( y ); } Math-Cephes-0.5306/libmd/kn.c0000644000175000017500000001031414757021403015436 0ustar shlomifshlomif/* kn.c * * Modified Bessel function, third kind, integer order * * * * SYNOPSIS: * * double x, y, kn(); * int n; * * y = kn( n, x ); * * * * DESCRIPTION: * * Returns modified Bessel function of the third kind * of order n of the argument. * * The range is partitioned into the two intervals [0,9.55] and * (9.55, infinity). An ascending power series is used in the * low range, and an asymptotic expansion in the high range. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 0,30 3000 1.3e-9 5.8e-11 * IEEE 0,30 90000 1.8e-8 3.0e-10 * * Error is high only near the crossover point x = 9.55 * between the two expansions used. */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier */ /* Algorithm for Kn. n-1 -n - (n-k-1)! 2 k K (x) = 0.5 (x/2) > -------- (-x /4) n - k! k=0 inf. 2 k n n - (x /4) + (-1) 0.5(x/2) > {p(k+1) + p(n+k+1) - 2log(x/2)} --------- - k! (n+k)! k=0 where p(m) is the psi function: p(1) = -EUL and m-1 - p(m) = -EUL + > 1/k - k=1 For large x, 2 2 2 u-1 (u-1 )(u-3 ) K (z) = sqrt(pi/2z) md_exp(-z) { 1 + ------- + ------------ + ...} v 1 2 1! (8z) 2! (8z) asymptotically, where 2 u = 4 v . */ #include "mconf.h" #define EUL 5.772156649015328606065e-1 #define MAXFAC 31 #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_exp ( double ); extern double md_log ( double ); extern double sqrt ( double ); #else double md_fabs(), md_exp(), md_log(), sqrt(); #endif extern double MACHEP, MAXNUM, MAXLOG, PI; double kn( nn, x ) int nn; double x; { double k, kf, nk1f, nkf, zn, t, s, z0, z; double ans, fn, pn, pk, zmn, tlg, tox; int i, n; if( nn < 0 ) n = -nn; else n = nn; if( n > MAXFAC ) { overf: mtherr( "kn", OVERFLOW ); return( MAXNUM ); } if( x <= 0.0 ) { if( x < 0.0 ) mtherr( "kn", DOMAIN ); else mtherr( "kn", SING ); return( MAXNUM ); } if( x > 9.55 ) goto asymp; ans = 0.0; z0 = 0.25 * x * x; fn = 1.0; pn = 0.0; zmn = 1.0; tox = 2.0/x; if( n > 0 ) { /* compute factorial of n and psi(n) */ pn = -EUL; k = 1.0; for( i=1; i 1.0) && ((MAXNUM/tox) < zmn) ) goto overf; zmn *= tox; } s *= 0.5; t = md_fabs(s); if( (zmn > 1.0) && ((MAXNUM/zmn) < t) ) goto overf; if( (t > 1.0) && ((MAXNUM/t) < zmn) ) goto overf; ans = s * zmn; } } tlg = 2.0 * md_log( 0.5 * x ); pk = -EUL; if( n == 0 ) { pn = pk; t = 1.0; } else { pn = pn + 1.0/n; t = 1.0/fn; } s = (pk+pn-tlg)*t; k = 1.0; do { t *= z0 / (k * (k+n)); pk += 1.0/k; pn += 1.0/(k+n); s += (pk+pn-tlg)*t; k += 1.0; } while( md_fabs(t/s) > MACHEP ); s = 0.5 * s / zmn; if( n & 1 ) s = -s; ans += s; return(ans); /* Asymptotic expansion for Kn(x) */ /* Converges to 1.4e-17 for x > 18.4 */ asymp: if( x > MAXLOG ) { mtherr( "kn", UNDERFLOW ); return(0.0); } k = n; pn = 4.0 * k * k; pk = 1.0; z0 = 8.0 * x; fn = 1.0; t = 1.0; s = t; nkf = MAXNUM; i = 0; do { z = pn - pk * pk; t = t * z /(fn * z0); nk1f = md_fabs(t); if( (i >= n) && (nk1f > nkf) ) { goto adone; } nkf = nk1f; s += t; fn += 1.0; pk += 2.0; i += 1; } while( md_fabs(t/s) > MACHEP ); adone: ans = md_exp(-x) * sqrt( PI/(2.0*x) ) * s; return(ans); } Math-Cephes-0.5306/libmd/floorelf.3870000644000175000017500000001010314757021403016731 0ustar shlomifshlomif .file "floor.c" .version "01.01" gcc2_compiled.: /* Caution, order of operands is reversed from usual Intel syntax */ .text .align 16 .globl ceil ceil: pushl %ebp movl %esp,%ebp pushl 12(%ebp) pushl 8(%ebp) call floor fcoml 8(%ebp) fnstsw %ax andb $69,%ah cmpb $1,%ah jne .L252 fld1 faddp %st,%st(1) .align 4 .L252: fldz fucom %st(1) fnstsw %ax andb $68,%ah xorb $64,%ah jne .L255 fcompl 8(%ebp) fnstsw %ax andb $69,%ah jne .L253 fstp %st(0) fldl NEGZERO movl %ebp,%esp popl %ebp ret .align 4 .L255: fstp %st(0) .L253: movl %ebp,%esp popl %ebp ret .Lfe1: .size ceil,.Lfe1-ceil .align 16 .globl floor floor: pushl %ebp movl %esp,%ebp subl $4,%esp fstcw -4(%ebp) fwait movw -4(%ebp),%ax andw $0xf3ff,%ax orw $0x400,%ax movw %ax,-2(%ebp) fldcw -2(%ebp) fldl 8(%ebp) frndint fldcw -4(%ebp) leave ret .Lfe2: .size floor,.Lfe2-floor .align 16 .globl frexp frexp: pushl %ebp movl %esp,%ebp subl $8,%esp pushl %ebx fldl 8(%ebp) movl 16(%ebp),%ebx fldz fucomp %st(1) fnstsw %ax andb $68,%ah xorb $64,%ah jne .L19 movl $0,(%ebx) jmp .L27 .align 4 .L19: fstpl -8(%ebp) leal -2(%ebp),%ecx movw -2(%ebp),%ax sarw $4,%ax movl %eax,%edx andl $2047,%edx jne .L21 .align 4 .L23: fldl -8(%ebp) fadd %st(0),%st fstpl -8(%ebp) decl %edx movw (%ecx),%ax sarw $4,%ax andl $2047,%eax je .L23 addl %eax,%edx .align 4 .L21: addl $-1022,%edx movl %edx,(%ebx) andw $32783,(%ecx) orw $16352,(%ecx) fldl -8(%ebp) .L27: movl -12(%ebp),%ebx movl %ebp,%esp popl %ebp ret .Lfe3: .size frexp,.Lfe3-frexp .data .align 4 .LC1: .long 0x0,0x3fe00000 .text .align 16 .globl ldexp ldexp: pushl %ebp movl %esp,%ebp subl $8,%esp fldl 8(%ebp) movl 16(%ebp),%edx fldz fucomp %st(1) fnstsw %ax andb $68,%ah xorb $64,%ah jne .L29 movl %ebp,%esp popl %ebp ret .align 4 .L53: fstp %st(1) fstp %st(1) fstp %st(1) movl %ebp,%esp popl %ebp ret .align 4 .L29: fstl -8(%ebp) leal -2(%ebp),%ecx fld1 testw $32752,-2(%ebp) jne .L51 fldl .LC1 .align 4 .L32: testl %edx,%edx jle .L33 fxch %st(1) fadd %st(0),%st fxch %st(1) decl %edx .align 4 .L33: testl %edx,%edx jge .L34 cmpl $-53,%edx jl .L52 fmul %st,%st(1) incl %edx .L34: fld %st(2) fmul %st(2),%st fstl -8(%ebp) testl %edx,%edx je .L53 fstp %st(0) testw $32752,(%ecx) je .L32 fstp %st(0) .align 4 .L51: fstp %st(0) fstp %st(0) movw (%ecx),%ax andw $32752,%ax sarw $4,%ax cwtl addl %edx,%eax cmpl $2046,%eax jle .L38 fldl MAXNUM fadd %st(0),%st movl %ebp,%esp popl %ebp ret .align 4 .L38: testl %eax,%eax jg .L39 cmpl $-53,%eax jge .L40 jmp .L49 .align 4 .L52: fstp %st(0) fstp %st(0) fstp %st(0) .L49: fldz movl %ebp,%esp popl %ebp ret .align 4 .L40: andw $32783,(%ecx) orb $16,(%ecx) leal -1(%eax),%eax pushl %eax /* pushl $1073741824 */ pushl $1072693248 pushl $0 call ldexp fmull (%ecx) movl %ebp,%esp popl %ebp ret .align 4 .L39: andw $32783,(%ecx) andb $7,%ah salw $4,%ax orw %ax,(%ecx) fldl -8(%ebp) movl %ebp,%esp popl %ebp ret .Lfe4: .size ldexp,.Lfe4-ldexp .align 16 .globl signbit signbit: pushl %ebp movl %esp,%ebp movl 12(%ebp),%eax shrl $31,%eax movl %ebp,%esp popl %ebp ret .Lfe5: .size signbit,.Lfe5-signbit .align 16 .globl isnan isnan: pushl %ebp movl %esp,%ebp pushl %ebx movl 8(%ebp),%ecx movl 12(%ebp),%ebx movl %ebx,%edx andl $2146435072,%edx cmpl $2146435072,%edx jne .L62 testl $1048575,%ebx jne .L63 testl %ecx,%ecx je .L62 .L63: movl $1,%eax jmp .L67 .align 4 .L62: xorl %eax,%eax .L67: movl -4(%ebp),%ebx movl %ebp,%esp popl %ebp ret .Lfe6: .size isnan,.Lfe6-isnan .align 16 .globl isfinite isfinite: pushl %ebp movl %esp,%ebp movl 12(%ebp),%eax andl $2146435072,%eax cmpl $2146435072,%eax jne .L70 xorl %eax,%eax movl %ebp,%esp popl %ebp ret .align 4 .L70: movl $1,%eax movl %ebp,%esp popl %ebp ret .Lfe7: .size isfinite,.Lfe7-isfinite .align 16 .globl fmod fmod: fldl 4(%esp) ftst fnstsw %ax sahf jz .L82 fldl 12(%esp) ftst fnstsw %ax sahf jz .L81 fxch %st(1) .L80: fprem fnstsw %ax sahf jpe .L80 .L81: fstp %st(1) .L82: ret .Lfe8: .size fmod,.Lfe8-fmod Math-Cephes-0.5306/libmd/bernum_wrap.c0000644000175000017500000000300614757021403017347 0ustar shlomifshlomif/* This program computes the Bernoulli numbers. * See radd.c for rational arithmetic. */ typedef struct{ double n; double d; }fract; #define PD 30 /* fract x[PD+1] = {0.0}; fract p[PD+1] = {0.0}; */ #include "mconf.h" #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_log10 ( double ); #else double md_fabs(), md_log10(); #endif extern double MACHEP; void bernum_wrap(num, den) double num[PD-2], den[PD-2]; { int nx, np; int i, k, n; fract s, t; extern void radd ( fract *, fract *, fract *); extern void rsub ( fract *, fract *, fract *); extern void rmul ( fract *, fract *, fract *); extern void rdiv ( fract *, fract *, fract *); fract x[PD+1], p[PD+1]; for(i=0; i<=PD; i++ ) { x[i].n = 0.0; x[i].d = 1.0; p[i].n = 0.0; p[i].d = 1.0; } p[0].n = 1.0; p[0].d = 1.0; p[1].n = 1.0; p[1].d = 1.0; np = 1; x[0].n = 1.0; x[0].d = 1.0; for( n=1; n> k) & 0xff; /* bring in next byte of arg */ if( j == 3 ) /* do roundoff bit at end */ n = 5; for( i=0; i= 0 ) { num = temp; /* it went in */ sq += 256; /* answer bit = 1 */ } } k -= 8; /* shift count to get next byte of arg */ } sq += 256; /* add roundoff bit */ sq >>= 9; /* truncate */ return( sq ); } Math-Cephes-0.5306/libmd/polmisc.c0000644000175000017500000001666414757022177016523 0ustar shlomifshlomif /* Square root, sine, cosine, and arctangent of polynomial. * See polyn.c for data structures and discussion. */ #include #include "mconf.h" #ifdef ANSIPROT extern double md_atan2 ( double, double ); extern double sqrt ( double ); extern double md_fabs ( double ); extern double md_sin ( double ); extern double md_cos ( double ); extern void polclr ( double *a, int n ); extern void polmov ( double *a, int na, double *b ); extern void polmul ( double a[], int na, double b[], int nb, double c[] ); extern void poladd ( double a[], int na, double b[], int nb, double c[] ); extern void polsub ( double a[], int na, double b[], int nb, double c[] ); extern int poldiv ( double a[], int na, double b[], int nb, double c[] ); extern void polsbt ( double a[], int na, double b[], int nb, double c[] ); extern void * malloc ( long ); extern void free ( void * ); #else double md_atan2(), sqrt(), md_fabs(), md_sin(), md_cos(); void polclr(), polmov(), polsbt(), poladd(), polsub(), polmul(); int poldiv(); void * malloc(); void free (); #endif /* Highest degree of polynomial to be handled by the polyn.c subroutine package. */ #define N 16 /* Highest degree actually initialized at runtime. */ extern int MAXPOL; /* Taylor series coefficients for various functions */ double patan[N+1] = { 0.0, 1.0, 0.0, -1.0/3.0, 0.0, 1.0/5.0, 0.0, -1.0/7.0, 0.0, 1.0/9.0, 0.0, -1.0/11.0, 0.0, 1.0/13.0, 0.0, -1.0/15.0, 0.0 }; double psin[N+1] = { 0.0, 1.0, 0.0, -1.0/6.0, 0.0, 1.0/120.0, 0.0, -1.0/5040.0, 0.0, 1.0/362880.0, 0.0, -1.0/39916800.0, 0.0, 1.0/6227020800.0, 0.0, -1.0/1.307674368e12, 0.0}; double pcos[N+1] = { 1.0, 0.0, -1.0/2.0, 0.0, 1.0/24.0, 0.0, -1.0/720.0, 0.0, 1.0/40320.0, 0.0, -1.0/3628800.0, 0.0, 1.0/479001600.0, 0.0, -1.0/8.7179291e10, 0.0, 1.0/2.0922789888e13}; double pasin[N+1] = { 0.0, 1.0, 0.0, 1.0/6.0, 0.0, 3.0/40.0, 0.0, 15.0/336.0, 0.0, 105.0/3456.0, 0.0, 945.0/42240.0, 0.0, 10395.0/599040.0 , 0.0, 135135.0/9676800.0 , 0.0 }; /* Square root of 1 + x. */ double psqrt[N+1] = { 1.0, 1./2., -1./8., 1./16., -5./128., 7./256., -21./1024., 33./2048., -429./32768., 715./65536., -2431./262144., 4199./524288., -29393./4194304., 52003./8388608., -185725./33554432., 334305./67108864., -9694845./2147483648.}; /* Arctangent of the ratio num/den of two polynomials. */ void polatn( num, den, ans, nn ) double num[], den[], ans[]; int nn; { double a, t; double *polq, *polu, *polt; int i; if (nn > N) { mtherr ("polatn", OVERFLOW); return; } /* arctan( a + b ) = arctan(a) + arctan( b/(1 + ab + a**2) ) */ t = num[0]; a = den[0]; if( (t == 0.0) && (a == 0.0 ) ) { t = num[1]; a = den[1]; } t = md_atan2( t, a ); /* arctan(num/den), the ANSI argument order */ polq = (double * )malloc( (MAXPOL+1) * sizeof (double) ); polu = (double * )malloc( (MAXPOL+1) * sizeof (double) ); polt = (double * )malloc( (MAXPOL+1) * sizeof (double) ); polclr( polq, MAXPOL ); i = poldiv( den, nn, num, nn, polq ); a = polq[0]; /* a */ polq[0] = 0.0; /* b */ polmov( polq, nn, polu ); /* b */ /* Form the polynomial 1 + ab + a**2 where a is a scalar. */ for( i=0; i<=nn; i++ ) polu[i] *= a; polu[0] += 1.0 + a * a; poldiv( polu, nn, polq, nn, polt ); /* divide into b */ polsbt( polt, nn, patan, nn, polu ); /* arctan(b) */ polu[0] += t; /* plus arctan(a) */ polmov( polu, nn, ans ); free( polt ); free( polu ); free( polq ); } /* Square root of a polynomial. * Assumes the lowest degree nonzero term is dominant * and of even degree. An error message is given * if the Newton iteration does not converge. */ void polsqt( pol, ans, nn ) double pol[], ans[]; int nn; { double t; double *x, *y; int i, n; #if 0 double z[N+1]; double u; #endif if (nn > N) { mtherr ("polatn", OVERFLOW); return; } x = (double * )malloc( (MAXPOL+1) * sizeof (double) ); y = (double * )malloc( (MAXPOL+1) * sizeof (double) ); polmov( pol, nn, x ); polclr( y, MAXPOL ); /* Find lowest degree nonzero term. */ t = 0.0; for( n=0; n 0 ) { if (n & 1) { printf("error, sqrt of odd polynomial\n"); return; } /* Divide by x^n. */ y[n] = x[n]; poldiv (y, nn, pol, N, x); } t = x[0]; for( i=1; i<=nn; i++ ) x[i] /= t; x[0] = 0.0; /* series development sqrt(1+x) = 1 + x / 2 - x**2 / 8 + x**3 / 16 hopes that first (constant) term is greater than what follows */ polsbt( x, nn, psqrt, nn, y); t = sqrt( t ); for( i=0; i<=nn; i++ ) y[i] *= t; /* If first nonzero coefficient was at degree n > 0, multiply by x^(n/2). */ if (n > 0) { polclr (x, MAXPOL); x[n/2] = 1.0; polmul (x, nn, y, nn, y); } #if 0 /* Newton iterations */ for( n=0; n<10; n++ ) { poldiv( y, nn, pol, nn, z ); poladd( y, nn, z, nn, y ); for( i=0; i<=nn; i++ ) y[i] *= 0.5; for( i=0; i<=nn; i++ ) { u = md_fabs( y[i] - z[i] ); if( u > 1.0e-15 ) goto more; } goto done; more: ; } printf( "square root did not converge\n" ); done: #endif /* 0 */ polmov( y, nn, ans ); free( y ); free( x ); } /* Sine of a polynomial. * The computation uses * md_sin(a+b) = md_sin(a) md_cos(b) + md_cos(a) md_sin(b) * where a is the constant term of the polynomial and * b is the sum of the rest of the terms. * Since md_sin(b) and md_cos(b) are computed by series expansions, * the value of b should be small. */ void polsin( x, y, nn ) double x[], y[]; int nn; { double a, sc; double *w, *c; int i; if (nn > N) { mtherr ("polatn", OVERFLOW); return; } w = (double * )malloc( (MAXPOL+1) * sizeof (double) ); c = (double * )malloc( (MAXPOL+1) * sizeof (double) ); polmov( x, nn, w ); polclr( c, MAXPOL ); polclr( y, nn ); /* a, in the description, is x[0]. b is the polynomial x - x[0]. */ a = w[0]; /* c = md_cos (b) */ w[0] = 0.0; polsbt( w, nn, pcos, nn, c ); sc = md_sin(a); /* md_sin(a) md_cos (b) */ for( i=0; i<=nn; i++ ) c[i] *= sc; /* y = md_sin (b) */ polsbt( w, nn, psin, nn, y ); sc = md_cos(a); /* md_cos(a) md_sin(b) */ for( i=0; i<=nn; i++ ) y[i] *= sc; poladd( c, nn, y, nn, y ); free( c ); free( w ); } /* Cosine of a polynomial. * The computation uses * md_cos(a+b) = md_cos(a) md_cos(b) - md_sin(a) md_sin(b) * where a is the constant term of the polynomial and * b is the sum of the rest of the terms. * Since md_sin(b) and md_cos(b) are computed by series expansions, * the value of b should be small. */ void polcos( x, y, nn ) double x[], y[]; int nn; { double a, sc; double *w, *c; int i; #ifdef ANSIPROT double md_sin(double), md_cos(double); #else double md_sin(), md_cos(); #endif if (nn > N) { mtherr ("polatn", OVERFLOW); return; } w = (double * )malloc( (MAXPOL+1) * sizeof (double) ); c = (double * )malloc( (MAXPOL+1) * sizeof (double) ); polmov( x, nn, w ); polclr( c, MAXPOL ); polclr( y, nn ); a = w[0]; w[0] = 0.0; /* c = md_cos(b) */ polsbt( w, nn, pcos, nn, c ); sc = md_cos(a); /* md_cos(a) md_cos(b) */ for( i=0; i<=nn; i++ ) c[i] *= sc; /* y = md_sin(b) */ polsbt( w, nn, psin, nn, y ); sc = md_sin(a); /* md_sin(a) md_sin(b) */ for( i=0; i<=nn; i++ ) y[i] *= sc; polsub( y, nn, c, nn, y ); free( c ); free( w ); } Math-Cephes-0.5306/libmd/expn.c0000644000175000017500000000625214757021403016006 0ustar shlomifshlomif/* md_expn.c * * Exponential integral En * * * * SYNOPSIS: * * int n; * double x, y, md_expn(); * * y = md_expn( n, x ); * * * * DESCRIPTION: * * Evaluates the exponential integral * * inf. * - * | | -xt * | e * E (x) = | ---- dt. * n | n * | | t * - * 1 * * * Both n and x must be nonnegative. * * The routine employs either a power series, a continued * fraction, or an asymptotic formula depending on the * relative values of n and x. * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 0, 30 5000 2.0e-16 4.6e-17 * IEEE 0, 30 10000 1.7e-15 3.6e-16 * */ /* md_expn.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1985, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double md_pow ( double, double ); extern double md_gamma ( double ); extern double md_log ( double ); extern double md_exp ( double ); extern double md_fabs ( double ); #else double md_pow(), md_gamma(), md_log(), md_exp(), md_fabs(); #endif #define EUL 0.57721566490153286060 #define BIG 1.44115188075855872E+17 extern double MAXNUM, MACHEP, MAXLOG; double md_expn( n, x ) int n; double x; { double ans, r, t, yk, xk; double pk, pkm1, pkm2, qk, qkm1, qkm2; double psi, z; int i, k; static double big = BIG; if( n < 0 ) goto domerr; if( x < 0 ) { domerr: mtherr( "md_expn", DOMAIN ); return( MAXNUM ); } if( x > MAXLOG ) return( 0.0 ); if( x == 0.0 ) { if( n < 2 ) { mtherr( "md_expn", SING ); return( MAXNUM ); } else return( 1.0/(n-1.0) ); } if( n == 0 ) return( md_exp(-x)/x ); /* md_expn.c */ /* Expansion for large n */ if( n > 5000 ) { xk = x + n; yk = 1.0 / (xk * xk); t = n; ans = yk * t * (6.0 * x * x - 8.0 * t * x + t * t); ans = yk * (ans + t * (t - 2.0 * x)); ans = yk * (ans + t); ans = (ans + 1.0) * md_exp( -x ) / xk; goto done; } if( x > 1.0 ) goto cfrac; /* md_expn.c */ /* Power series expansion */ psi = -EUL - md_log(x); for( i=1; i MACHEP ); k = xk; t = n; r = n - 1; ans = (md_pow(z, r) * psi / md_gamma(t)) - ans; goto done; /* md_expn.c */ /* continued fraction */ cfrac: k = 1; pkm2 = 1.0; qkm2 = x; pkm1 = 1.0; qkm1 = x + n; ans = pkm1/qkm1; do { k += 1; if( k & 1 ) { yk = 1.0; xk = n + (k-1)/2; } else { yk = x; xk = k/2; } pk = pkm1 * yk + pkm2 * xk; qk = qkm1 * yk + qkm2 * xk; if( qk != 0 ) { r = pk/qk; t = md_fabs( (ans - r)/r ); ans = r; } else t = 1.0; pkm2 = pkm1; pkm1 = pk; qkm2 = qkm1; qkm1 = qk; if( md_fabs(pk) > big ) { pkm2 /= big; pkm1 /= big; qkm2 /= big; qkm1 /= big; } } while( t > MACHEP ); ans *= md_exp( -x ); done: return( ans ); } Math-Cephes-0.5306/libmd/fac.c0000644000175000017500000001361014757021403015561 0ustar shlomifshlomif/* fac.c * * Factorial function * * * * SYNOPSIS: * * double y, fac(); * int i; * * y = fac( i ); * * * * DESCRIPTION: * * Returns factorial of i = 1 * 2 * 3 * ... * i. * fac(0) = 1.0. * * Due to machine arithmetic bounds the largest value of * i accepted is 33 in DEC arithmetic or 170 in IEEE * arithmetic. Greater values, or negative ones, * produce an error message and return MAXNUM. * * * * ACCURACY: * * For i < 34 the values are simply tabulated, and have * full machine accuracy. If i > 55, fac(i) = md_gamma(i+1); * see md_gamma.c. * * Relative error: * arithmetic domain peak * IEEE 0, 170 1.4e-15 * DEC 0, 33 1.4e-17 * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" /* Factorials of integers from 0 through 33 */ #ifdef UNK static double factbl[] = { 1.00000000000000000000E0, 1.00000000000000000000E0, 2.00000000000000000000E0, 6.00000000000000000000E0, 2.40000000000000000000E1, 1.20000000000000000000E2, 7.20000000000000000000E2, 5.04000000000000000000E3, 4.03200000000000000000E4, 3.62880000000000000000E5, 3.62880000000000000000E6, 3.99168000000000000000E7, 4.79001600000000000000E8, 6.22702080000000000000E9, 8.71782912000000000000E10, 1.30767436800000000000E12, 2.09227898880000000000E13, 3.55687428096000000000E14, 6.40237370572800000000E15, 1.21645100408832000000E17, 2.43290200817664000000E18, 5.10909421717094400000E19, 1.12400072777760768000E21, 2.58520167388849766400E22, 6.20448401733239439360E23, 1.55112100433309859840E25, 4.03291461126605635584E26, 1.0888869450418352160768E28, 3.04888344611713860501504E29, 8.841761993739701954543616E30, 2.6525285981219105863630848E32, 8.22283865417792281772556288E33, 2.6313083693369353016721801216E35, 8.68331761881188649551819440128E36 }; #define MAXFAC 33 #endif #ifdef DEC static unsigned short factbl[] = { 0040200,0000000,0000000,0000000, 0040200,0000000,0000000,0000000, 0040400,0000000,0000000,0000000, 0040700,0000000,0000000,0000000, 0041300,0000000,0000000,0000000, 0041760,0000000,0000000,0000000, 0042464,0000000,0000000,0000000, 0043235,0100000,0000000,0000000, 0044035,0100000,0000000,0000000, 0044661,0030000,0000000,0000000, 0045535,0076000,0000000,0000000, 0046430,0042500,0000000,0000000, 0047344,0063740,0000000,0000000, 0050271,0112146,0000000,0000000, 0051242,0060731,0040000,0000000, 0052230,0035673,0126000,0000000, 0053230,0035673,0126000,0000000, 0054241,0137567,0063300,0000000, 0055265,0173546,0051630,0000000, 0056330,0012711,0101504,0100000, 0057407,0006635,0171012,0150000, 0060461,0040737,0046656,0030400, 0061563,0135223,0005317,0101540, 0062657,0027031,0127705,0023155, 0064003,0061223,0041723,0156322, 0065115,0045006,0014773,0004410, 0066246,0146044,0172433,0173526, 0067414,0136077,0027317,0114261, 0070566,0044556,0110753,0045465, 0071737,0031214,0032075,0036050, 0073121,0037543,0070371,0064146, 0074312,0132550,0052561,0116443, 0075512,0132550,0052561,0116443, 0076721,0005423,0114035,0025014 }; #define MAXFAC 33 #endif #ifdef IBMPC static unsigned short factbl[] = { 0x0000,0x0000,0x0000,0x3ff0, 0x0000,0x0000,0x0000,0x3ff0, 0x0000,0x0000,0x0000,0x4000, 0x0000,0x0000,0x0000,0x4018, 0x0000,0x0000,0x0000,0x4038, 0x0000,0x0000,0x0000,0x405e, 0x0000,0x0000,0x8000,0x4086, 0x0000,0x0000,0xb000,0x40b3, 0x0000,0x0000,0xb000,0x40e3, 0x0000,0x0000,0x2600,0x4116, 0x0000,0x0000,0xaf80,0x414b, 0x0000,0x0000,0x08a8,0x4183, 0x0000,0x0000,0x8cfc,0x41bc, 0x0000,0xc000,0x328c,0x41f7, 0x0000,0x2800,0x4c3b,0x4234, 0x0000,0x7580,0x0777,0x4273, 0x0000,0x7580,0x0777,0x42b3, 0x0000,0xecd8,0x37ee,0x42f4, 0x0000,0xca73,0xbeec,0x4336, 0x9000,0x3068,0x02b9,0x437b, 0x5a00,0xbe41,0xe1b3,0x43c0, 0xc620,0xe9b5,0x283b,0x4406, 0xf06c,0x6159,0x7752,0x444e, 0xa4ce,0x35f8,0xe5c3,0x4495, 0x7b9a,0x687a,0x6c52,0x44e0, 0x6121,0xc33f,0xa940,0x4529, 0x7eeb,0x9ea3,0xd984,0x4574, 0xf316,0xe5d9,0x9787,0x45c1, 0x6967,0xd23d,0xc92d,0x460e, 0xa785,0x8687,0xe651,0x465b, 0x2d0d,0x6e1f,0x27ec,0x46aa, 0x33a4,0x0aae,0x56ad,0x46f9, 0x33a4,0x0aae,0x56ad,0x4749, 0xa541,0x7303,0x2162,0x479a }; #define MAXFAC 170 #endif #ifdef MIEEE static unsigned short factbl[] = { 0x3ff0,0x0000,0x0000,0x0000, 0x3ff0,0x0000,0x0000,0x0000, 0x4000,0x0000,0x0000,0x0000, 0x4018,0x0000,0x0000,0x0000, 0x4038,0x0000,0x0000,0x0000, 0x405e,0x0000,0x0000,0x0000, 0x4086,0x8000,0x0000,0x0000, 0x40b3,0xb000,0x0000,0x0000, 0x40e3,0xb000,0x0000,0x0000, 0x4116,0x2600,0x0000,0x0000, 0x414b,0xaf80,0x0000,0x0000, 0x4183,0x08a8,0x0000,0x0000, 0x41bc,0x8cfc,0x0000,0x0000, 0x41f7,0x328c,0xc000,0x0000, 0x4234,0x4c3b,0x2800,0x0000, 0x4273,0x0777,0x7580,0x0000, 0x42b3,0x0777,0x7580,0x0000, 0x42f4,0x37ee,0xecd8,0x0000, 0x4336,0xbeec,0xca73,0x0000, 0x437b,0x02b9,0x3068,0x9000, 0x43c0,0xe1b3,0xbe41,0x5a00, 0x4406,0x283b,0xe9b5,0xc620, 0x444e,0x7752,0x6159,0xf06c, 0x4495,0xe5c3,0x35f8,0xa4ce, 0x44e0,0x6c52,0x687a,0x7b9a, 0x4529,0xa940,0xc33f,0x6121, 0x4574,0xd984,0x9ea3,0x7eeb, 0x45c1,0x9787,0xe5d9,0xf316, 0x460e,0xc92d,0xd23d,0x6967, 0x465b,0xe651,0x8687,0xa785, 0x46aa,0x27ec,0x6e1f,0x2d0d, 0x46f9,0x56ad,0x0aae,0x33a4, 0x4749,0x56ad,0x0aae,0x33a4, 0x479a,0x2162,0x7303,0xa541 }; #define MAXFAC 170 #endif #ifdef ANSIPROT double md_gamma ( double ); #else double md_gamma(); #endif extern double MAXNUM; double fac(i) int i; { double x, f, n; int j; if( i < 0 ) { mtherr( "fac", SING ); return( MAXNUM ); } if( i > MAXFAC ) { mtherr( "fac", OVERFLOW ); return( MAXNUM ); } /* Get answer from table for small i. */ if( i < 34 ) { #ifdef UNK return( factbl[i] ); #else return( *(double *)(&factbl[4*i]) ); #endif } /* Use md_gamma function for large i. */ if( i > 55 ) { x = i + 1; return( md_gamma(x) ); } /* Compute directly for intermediate i. */ n = 34.0; f = 34.0; for( j=35; j<=i; j++ ) { n += 1.0; f *= n; } #ifdef UNK f *= factbl[33]; #else f *= *(double *)(&factbl[4*33]); #endif return( f ); } Math-Cephes-0.5306/libmd/fdtr.c0000644000175000017500000001211514757021403015766 0ustar shlomifshlomif/* fdtr.c * * F distribution * * * * SYNOPSIS: * * int df1, df2; * double x, y, fdtr(); * * y = fdtr( df1, df2, x ); * * DESCRIPTION: * * Returns the area from zero to x under the F density * function (also known as Snedcor's density or the * variance ratio density). This is the density * of x = (u1/df1)/(u2/df2), where u1 and u2 are random * variables having Chi square distributions with df1 * and df2 degrees of freedom, respectively. * * The incomplete beta integral is used, according to the * formula * * P(x) = incbet( df1/2, df2/2, (df1*x/(df2 + df1*x) ). * * * The arguments a and b are greater than zero, and x is * nonnegative. * * ACCURACY: * * Tested at random points (a,b,x). * * x a,b Relative error: * arithmetic domain domain # trials peak rms * IEEE 0,1 0,100 100000 9.8e-15 1.7e-15 * IEEE 1,5 0,100 100000 6.5e-15 3.5e-16 * IEEE 0,1 1,10000 100000 2.2e-11 3.3e-12 * IEEE 1,5 1,10000 100000 1.1e-11 1.7e-13 * See also incbet.c. * * * ERROR MESSAGES: * * message condition value returned * fdtr domain a<0, b<0, x<0 0.0 * */ /* fdtrc() * * Complemented F distribution * * * * SYNOPSIS: * * int df1, df2; * double x, y, fdtrc(); * * y = fdtrc( df1, df2, x ); * * DESCRIPTION: * * Returns the area from x to infinity under the F density * function (also known as Snedcor's density or the * variance ratio density). * * * inf. * - * 1 | | a-1 b-1 * 1-P(x) = ------ | t (1-t) dt * B(a,b) | | * - * x * * * The incomplete beta integral is used, according to the * formula * * P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ). * * * ACCURACY: * * Tested at random points (a,b,x) in the indicated intervals. * x a,b Relative error: * arithmetic domain domain # trials peak rms * IEEE 0,1 1,100 100000 3.7e-14 5.9e-16 * IEEE 1,5 1,100 100000 8.0e-15 1.6e-15 * IEEE 0,1 1,10000 100000 1.8e-11 3.5e-13 * IEEE 1,5 1,10000 100000 2.0e-11 3.0e-12 * See also incbet.c. * * ERROR MESSAGES: * * message condition value returned * fdtrc domain a<0, b<0, x<0 0.0 * */ /* fdtri() * * Inverse of complemented F distribution * * * * SYNOPSIS: * * int df1, df2; * double x, p, fdtri(); * * x = fdtri( df1, df2, p ); * * DESCRIPTION: * * Finds the F density argument x such that the integral * from x to infinity of the F density is equal to the * given probability p. * * This is accomplished using the inverse beta integral * function and the relations * * z = incbi( df2/2, df1/2, p ) * x = df2 (1-z) / (df1 z). * * Note: the following relations hold for the inverse of * the uncomplemented F distribution: * * z = incbi( df1/2, df2/2, p ) * x = df2 z / (df1 (1-z)). * * ACCURACY: * * Tested at random points (a,b,p). * * a,b Relative error: * arithmetic domain # trials peak rms * For p between .001 and 1: * IEEE 1,100 100000 8.3e-15 4.7e-16 * IEEE 1,10000 100000 2.1e-11 1.4e-13 * For p between 10^-6 and 10^-3: * IEEE 1,100 50000 1.3e-12 8.4e-15 * IEEE 1,10000 50000 3.0e-12 4.8e-14 * See also fdtrc.c. * * ERROR MESSAGES: * * message condition value returned * fdtri domain p <= 0 or p > 1 0.0 * v < 1 * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double incbet ( double, double, double ); extern double incbi ( double, double, double ); #else double incbet(), incbi(); #endif double fdtrc( ia, ib, x ) int ia, ib; double x; { double a, b, w; if( (ia < 1) || (ib < 1) || (x < 0.0) ) { mtherr( "fdtrc", DOMAIN ); return( 0.0 ); } a = ia; b = ib; w = b / (b + a * x); return( incbet( 0.5*b, 0.5*a, w ) ); } double fdtr( ia, ib, x ) int ia, ib; double x; { double a, b, w; if( (ia < 1) || (ib < 1) || (x < 0.0) ) { mtherr( "fdtr", DOMAIN ); return( 0.0 ); } a = ia; b = ib; w = a * x; w = w / (b + w); return( incbet(0.5*a, 0.5*b, w) ); } double fdtri( ia, ib, y ) int ia, ib; double y; { double a, b, w, x; if( (ia < 1) || (ib < 1) || (y <= 0.0) || (y > 1.0) ) { mtherr( "fdtri", DOMAIN ); return( 0.0 ); } a = ia; b = ib; /* Compute probability for x = 0.5. */ w = incbet( 0.5*b, 0.5*a, 0.5 ); /* If that is greater than y, then the solution w < .5. Otherwise, solve at 1-y to remove cancellation in (b - b*w). */ if( w > y || y < 0.001) { w = incbi( 0.5*b, 0.5*a, y ); x = (b - b*w)/(a*w); } else { w = incbi( 0.5*a, 0.5*b, 1.0-y ); x = b*w/(a*(1.0-w)); } return(x); } Math-Cephes-0.5306/libmd/setprec.c0000644000175000017500000000020314757250372016500 0ustar shlomifshlomif/* Null stubs for coprocessor precision settings */ int sprec() {return 0; } int dprec() {return 0; } int ldprec() {return 0; } Math-Cephes-0.5306/libmd/mtransp.c0000644000175000017500000000177514757021403016525 0ustar shlomifshlomif/* mtransp.c * * Matrix transpose * * * * SYNOPSIS: * * int n; * double A[n*n], T[n*n]; * * mtransp( n, A, T ); * * * * DESCRIPTION: * * * T[r][c] = A[c][r] * * * Transposes the n by n square matrix A and puts the result in T. * The output, T, may occupy the same storage as A. * * * */ void mtransp( n, A, T ) int n; double *A, *T; { int i, j, np1; double *pAc, *pAr, *pTc, *pTr, *pA0, *pT0; double x; np1 = n+1; pA0 = A; pT0 = T; for( i=0; i e -- * -- j! * j=0 * * The terms are not summed directly; instead the incomplete * md_gamma integral is employed, according to the relation * * y = pdtr( k, m ) = igamc( k+1, m ). * * The arguments must both be positive. * * * * ACCURACY: * * See igamc(). * */ /* pdtrc() * * Complemented poisson distribution * * * * SYNOPSIS: * * int k; * double m, y, pdtrc(); * * y = pdtrc( k, m ); * * * * DESCRIPTION: * * Returns the sum of the terms k+1 to infinity of the Poisson * distribution: * * inf. j * -- -m m * > e -- * -- j! * j=k+1 * * The terms are not summed directly; instead the incomplete * md_gamma integral is employed, according to the formula * * y = pdtrc( k, m ) = igam( k+1, m ). * * The arguments must both be positive. * * * * ACCURACY: * * See igam.c. * */ /* pdtri() * * Inverse Poisson distribution * * * * SYNOPSIS: * * int k; * double m, y, pdtr(); * * m = pdtri( k, y ); * * * * * DESCRIPTION: * * Finds the Poisson variable x such that the integral * from 0 to x of the Poisson density is equal to the * given probability y. * * This is accomplished using the inverse md_gamma integral * function and the relation * * m = igami( k+1, y ). * * * * * ACCURACY: * * See igami.c. * * ERROR MESSAGES: * * message condition value returned * pdtri domain y < 0 or y >= 1 0.0 * k < 0 * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double igam ( double, double ); extern double igamc ( double, double ); extern double igami ( double, double ); #else double igam(), igamc(), igami(); #endif double pdtrc( k, m ) int k; double m; { double v; if( (k < 0) || (m <= 0.0) ) { mtherr( "pdtrc", DOMAIN ); return( 0.0 ); } v = k+1; return( igam( v, m ) ); } double pdtr( k, m ) int k; double m; { double v; if( (k < 0) || (m <= 0.0) ) { mtherr( "pdtr", DOMAIN ); return( 0.0 ); } v = k+1; return( igamc( v, m ) ); } double pdtri( k, y ) int k; double y; { double v; if( (k < 0) || (y < 0.0) || (y >= 1.0) ) { mtherr( "pdtri", DOMAIN ); return( 0.0 ); } v = k+1; v = igami( v, y ); return( v ); } Math-Cephes-0.5306/libmd/const.c0000644000175000017500000002264114757021403016162 0ustar shlomifshlomif/* const.c * * Globally declared constants * * * * SYNOPSIS: * * extern double nameofconstant; * * * * * DESCRIPTION: * * This file contains a number of mathematical constants and * also some needed size parameters of the computer arithmetic. * The values are supplied as arrays of hexadecimal integers * for IEEE arithmetic; arrays of octal constants for DEC * arithmetic; and in a normal decimal scientific notation for * other machines. The particular notation used is determined * by a symbol (DEC, IBMPC, or UNK) defined in the include file * mconf.h. * * The default size parameters are as follows. * * For DEC and UNK modes: * MACHEP = 1.38777878078144567553E-17 2**-56 * MAXLOG = 8.8029691931113054295988E1 md_log(2**127) * MINLOG = -8.872283911167299960540E1 md_log(2**-128) * MAXNUM = 1.701411834604692317316873e38 2**127 * * For IEEE arithmetic (IBMPC): * MACHEP = 1.11022302462515654042E-16 2**-53 * MAXLOG = 7.09782712893383996843E2 md_log(2**1024) * MINLOG = -7.08396418532264106224E2 md_log(2**-1022) * MAXNUM = 1.7976931348623158E308 2**1024 * * The global symbols for mathematical constants are * PI = 3.14159265358979323846 pi * PIO2 = 1.57079632679489661923 pi/2 * PIO4 = 7.85398163397448309616E-1 pi/4 * SQRT2 = 1.41421356237309504880 sqrt(2) * SQRTH = 7.07106781186547524401E-1 sqrt(2)/2 * LOG2E = 1.4426950408889634073599 1/md_log(2) * SQ2OPI = 7.9788456080286535587989E-1 sqrt( 2/pi ) * LOGE2 = 6.93147180559945309417E-1 md_log(2) * LOGSQ2 = 3.46573590279972654709E-1 md_log(2)/2 * THPIO4 = 2.35619449019234492885 3*pi/4 * TWOOPI = 6.36619772367581343075535E-1 2/pi * * These lists are subject to change. */ /* const.c */ /* Cephes Math Library Release 2.3: March, 1995 Copyright 1984, 1995 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK #if 1 double MACHEP = 1.11022302462515654042E-16; /* 2**-53 */ #else double MACHEP = 1.38777878078144567553E-17; /* 2**-56 */ #endif double UFLOWTHRESH = 2.22507385850720138309E-308; /* 2**-1022 */ #ifdef DENORMAL double MAXLOG = 7.09782712893383996732E2; /* md_log(MAXNUM) */ /* double MINLOG = -7.44440071921381262314E2; */ /* md_log(2**-1074) */ double MINLOG = -7.451332191019412076235E2; /* md_log(2**-1075) */ #else double MAXLOG = 7.08396418532264106224E2; /* md_log 2**1022 */ double MINLOG = -7.08396418532264106224E2; /* md_log 2**-1022 */ #endif double MAXNUM = 1.79769313486231570815E308; /* 2**1024*(1-MACHEP) */ double PI = 3.14159265358979323846; /* pi */ double PIO2 = 1.57079632679489661923; /* pi/2 */ double PIO4 = 7.85398163397448309616E-1; /* pi/4 */ double SQRT2 = 1.41421356237309504880; /* sqrt(2) */ double SQRTH = 7.07106781186547524401E-1; /* sqrt(2)/2 */ double LOG2E = 1.4426950408889634073599; /* 1/md_log(2) */ double SQ2OPI = 7.9788456080286535587989E-1; /* sqrt( 2/pi ) */ double LOGE2 = 6.93147180559945309417E-1; /* md_log(2) */ double LOGSQ2 = 3.46573590279972654709E-1; /* md_log(2)/2 */ double THPIO4 = 2.35619449019234492885; /* 3*pi/4 */ double TWOOPI = 6.36619772367581343075535E-1; /* 2/pi */ #ifdef INFINITIES double INFINITY = 1.0/0.0; /* 99e999; */ #else double INFINITY = 1.79769313486231570815E308; /* 2**1024*(1-MACHEP) */ #endif #ifdef NANS double NAN = 1.0/0.0 - 1.0/0.0; #else double NAN = 0.0; #endif #ifdef MINUSZERO double NEGZERO = -0.0; #else double NEGZERO = 0.0; #endif #endif #ifdef IBMPC /* 2**-53 = 1.11022302462515654042E-16 */ unsigned short MACHEP[4] = {0x0000,0x0000,0x0000,0x3ca0}; unsigned short UFLOWTHRESH[4] = {0x0000,0x0000,0x0000,0x0010}; #ifdef DENORMAL /* md_log(MAXNUM) = 7.09782712893383996732224E2 */ unsigned short MAXLOG[4] = {0x39ef,0xfefa,0x2e42,0x4086}; /* md_log(2**-1074) = - -7.44440071921381262314E2 */ /*unsigned short MINLOG[4] = {0x71c3,0x446d,0x4385,0xc087};*/ unsigned short MINLOG[4] = {0x3052,0xd52d,0x4910,0xc087}; #else /* md_log(2**1022) = 7.08396418532264106224E2 */ unsigned short MAXLOG[4] = {0xbcd2,0xdd7a,0x232b,0x4086}; /* md_log(2**-1022) = - 7.08396418532264106224E2 */ unsigned short MINLOG[4] = {0xbcd2,0xdd7a,0x232b,0xc086}; #endif /* 2**1024*(1-MACHEP) = 1.7976931348623158E308 */ unsigned short MAXNUM[4] = {0xffff,0xffff,0xffff,0x7fef}; unsigned short PI[4] = {0x2d18,0x5444,0x21fb,0x4009}; unsigned short PIO2[4] = {0x2d18,0x5444,0x21fb,0x3ff9}; unsigned short PIO4[4] = {0x2d18,0x5444,0x21fb,0x3fe9}; unsigned short SQRT2[4] = {0x3bcd,0x667f,0xa09e,0x3ff6}; unsigned short SQRTH[4] = {0x3bcd,0x667f,0xa09e,0x3fe6}; unsigned short LOG2E[4] = {0x82fe,0x652b,0x1547,0x3ff7}; unsigned short SQ2OPI[4] = {0x3651,0x33d4,0x8845,0x3fe9}; unsigned short LOGE2[4] = {0x39ef,0xfefa,0x2e42,0x3fe6}; unsigned short LOGSQ2[4] = {0x39ef,0xfefa,0x2e42,0x3fd6}; unsigned short THPIO4[4] = {0x21d2,0x7f33,0xd97c,0x4002}; unsigned short TWOOPI[4] = {0xc883,0x6dc9,0x5f30,0x3fe4}; #ifdef INFINITIES unsigned short INFINITY[4] = {0x0000,0x0000,0x0000,0x7ff0}; #else unsigned short INFINITY[4] = {0xffff,0xffff,0xffff,0x7fef}; #endif #ifdef NANS unsigned short NAN[4] = {0x0000,0x0000,0x0000,0x7ffc}; #else unsigned short NAN[4] = {0x0000,0x0000,0x0000,0x0000}; #endif #ifdef MINUSZERO unsigned short NEGZERO[4] = {0x0000,0x0000,0x0000,0x8000}; #else unsigned short NEGZERO[4] = {0x0000,0x0000,0x0000,0x0000}; #endif #endif #ifdef MIEEE /* 2**-53 = 1.11022302462515654042E-16 */ unsigned short MACHEP[4] = {0x3ca0,0x0000,0x0000,0x0000}; unsigned short UFLOWTHRESH[4] = {0x0010,0x0000,0x0000,0x0000}; #ifdef DENORMAL /* md_log(2**1024) = 7.09782712893383996843E2 */ unsigned short MAXLOG[4] = {0x4086,0x2e42,0xfefa,0x39ef}; /* md_log(2**-1074) = - -7.44440071921381262314E2 */ /* unsigned short MINLOG[4] = {0xc087,0x4385,0x446d,0x71c3}; */ unsigned short MINLOG[4] = {0xc087,0x4910,0xd52d,0x3052}; #else /* md_log(2**1022) = 7.08396418532264106224E2 */ unsigned short MAXLOG[4] = {0x4086,0x232b,0xdd7a,0xbcd2}; /* md_log(2**-1022) = - 7.08396418532264106224E2 */ unsigned short MINLOG[4] = {0xc086,0x232b,0xdd7a,0xbcd2}; #endif /* 2**1024*(1-MACHEP) = 1.7976931348623158E308 */ unsigned short MAXNUM[4] = {0x7fef,0xffff,0xffff,0xffff}; unsigned short PI[4] = {0x4009,0x21fb,0x5444,0x2d18}; unsigned short PIO2[4] = {0x3ff9,0x21fb,0x5444,0x2d18}; unsigned short PIO4[4] = {0x3fe9,0x21fb,0x5444,0x2d18}; unsigned short SQRT2[4] = {0x3ff6,0xa09e,0x667f,0x3bcd}; unsigned short SQRTH[4] = {0x3fe6,0xa09e,0x667f,0x3bcd}; unsigned short LOG2E[4] = {0x3ff7,0x1547,0x652b,0x82fe}; unsigned short SQ2OPI[4] = {0x3fe9,0x8845,0x33d4,0x3651}; unsigned short LOGE2[4] = {0x3fe6,0x2e42,0xfefa,0x39ef}; unsigned short LOGSQ2[4] = {0x3fd6,0x2e42,0xfefa,0x39ef}; unsigned short THPIO4[4] = {0x4002,0xd97c,0x7f33,0x21d2}; unsigned short TWOOPI[4] = {0x3fe4,0x5f30,0x6dc9,0xc883}; #ifdef INFINITIES unsigned short INFINITY[4] = {0x7ff0,0x0000,0x0000,0x0000}; #else unsigned short INFINITY[4] = {0x7fef,0xffff,0xffff,0xffff}; #endif #ifdef NANS unsigned short NAN[4] = {0x7ff8,0x0000,0x0000,0x0000}; #else unsigned short NAN[4] = {0x0000,0x0000,0x0000,0x0000}; #endif #ifdef MINUSZERO unsigned short NEGZERO[4] = {0x8000,0x0000,0x0000,0x0000}; #else unsigned short NEGZERO[4] = {0x0000,0x0000,0x0000,0x0000}; #endif #endif #ifdef DEC /* 2**-56 = 1.38777878078144567553E-17 */ unsigned short MACHEP[4] = {0022200,0000000,0000000,0000000}; unsigned short UFLOWTHRESH[4] = {0x0080,0x0000,0x0000,0x0000}; /* md_log 2**127 = 88.029691931113054295988 */ unsigned short MAXLOG[4] = {041660,007463,0143742,025733,}; /* md_log 2**-128 = -88.72283911167299960540 */ unsigned short MINLOG[4] = {0141661,071027,0173721,0147572,}; /* 2**127 = 1.701411834604692317316873e38 */ unsigned short MAXNUM[4] = {077777,0177777,0177777,0177777,}; unsigned short PI[4] = {040511,007732,0121041,064302,}; unsigned short PIO2[4] = {040311,007732,0121041,064302,}; unsigned short PIO4[4] = {040111,007732,0121041,064302,}; unsigned short SQRT2[4] = {040265,002363,031771,0157145,}; unsigned short SQRTH[4] = {040065,002363,031771,0157144,}; unsigned short LOG2E[4] = {040270,0125073,024534,013761,}; unsigned short SQ2OPI[4] = {040114,041051,0117241,0131204,}; unsigned short LOGE2[4] = {040061,071027,0173721,0147572,}; unsigned short LOGSQ2[4] = {037661,071027,0173721,0147572,}; unsigned short THPIO4[4] = {040426,0145743,0174631,007222,}; unsigned short TWOOPI[4] = {040042,0174603,067116,042025,}; /* Approximate infinity by MAXNUM. */ unsigned short INFINITY[4] = {077777,0177777,0177777,0177777,}; unsigned short NAN[4] = {0000000,0000000,0000000,0000000}; #ifdef MINUSZERO unsigned short NEGZERO[4] = {0000000,0000000,0000000,0100000}; #else unsigned short NEGZERO[4] = {0000000,0000000,0000000,0000000}; #endif #endif #ifndef UNK extern unsigned short MACHEP[]; extern unsigned short UFLOWTHRESH[]; extern unsigned short MAXLOG[]; extern unsigned short UNDLOG[]; extern unsigned short MINLOG[]; extern unsigned short MAXNUM[]; extern unsigned short PI[]; extern unsigned short PIO2[]; extern unsigned short PIO4[]; extern unsigned short SQRT2[]; extern unsigned short SQRTH[]; extern unsigned short LOG2E[]; extern unsigned short SQ2OPI[]; extern unsigned short LOGE2[]; extern unsigned short LOGSQ2[]; extern unsigned short THPIO4[]; extern unsigned short TWOOPI[]; extern unsigned short INFINITY[]; extern unsigned short NAN[]; extern unsigned short NEGZERO[]; #endif Math-Cephes-0.5306/libmd/sqrt.c0000644000175000017500000000544314757250372016037 0ustar shlomifshlomif/* sqrt.c * * Square root * * * * SYNOPSIS: * * double x, y, sqrt(); * * y = sqrt( x ); * * * * DESCRIPTION: * * Returns the square root of x. * * Range reduction involves isolating the power of two of the * argument and using a polynomial approximation to obtain * a rough value for the square root. Then Heron's iteration * is used three times to converge to an accurate value. * * * * ACCURACY: * * * Relative error: * arithmetic domain # trials peak rms * DEC 0, 10 60000 2.1e-17 7.9e-18 * IEEE 0,1.7e308 30000 1.7e-16 6.3e-17 * * * ERROR MESSAGES: * * message condition value returned * sqrt domain x < 0 0.0 * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double frexp ( double, int * ); extern double ldexp ( double, int ); #else double frexp(), ldexp(); #endif extern double SQRT2; /* SQRT2 = 1.41421356237309504880 */ double sqrt(x) double x; { int e; #ifndef UNK short *q; #endif double z, w; if( x <= 0.0 ) { if( x < 0.0 ) mtherr( "sqrt", DOMAIN ); return( 0.0 ); } w = x; /* separate exponent and significand */ #ifdef UNK z = frexp( x, &e ); #endif #ifdef DEC q = (short *)&x; e = ((*q >> 7) & 0377) - 0200; *q &= 0177; *q |= 040000; z = x; #endif /* Note, frexp and ldexp are used in order to * handle denormal numbers properly. */ #ifdef IBMPC z = frexp( x, &e ); q = (short *)&x; q += 3; /* e = ((*q >> 4) & 0x0fff) - 0x3fe; *q &= 0x000f; *q |= 0x3fe0; z = x; */ #endif #ifdef MIEEE z = frexp( x, &e ); q = (short *)&x; /* e = ((*q >> 4) & 0x0fff) - 0x3fe; *q &= 0x000f; *q |= 0x3fe0; z = x; */ #endif /* approximate square root of number between 0.5 and 1 * relative error of approximation = 7.47e-3 */ x = 4.173075996388649989089E-1 + 5.9016206709064458299663E-1 * z; /* adjust for odd powers of 2 */ if( (e & 1) != 0 ) x *= SQRT2; /* re-insert exponent */ #ifdef UNK x = ldexp( x, (e >> 1) ); #endif #ifdef DEC *q += ((e >> 1) & 0377) << 7; *q &= 077777; #endif #ifdef IBMPC x = ldexp( x, (e >> 1) ); /* *q += ((e >>1) & 0x7ff) << 4; *q &= 077777; */ #endif #ifdef MIEEE x = ldexp( x, (e >> 1) ); /* *q += ((e >>1) & 0x7ff) << 4; *q &= 077777; */ #endif /* Newton iterations: */ #ifdef UNK x = 0.5*(x + w/x); x = 0.5*(x + w/x); x = 0.5*(x + w/x); #endif /* Note, assume the square root cannot be denormal, * so it is safe to use integer exponent operations here. */ #ifdef DEC x += w/x; *q -= 0200; x += w/x; *q -= 0200; x += w/x; *q -= 0200; #endif #ifdef IBMPC x += w/x; *q -= 0x10; x += w/x; *q -= 0x10; x += w/x; *q -= 0x10; #endif #ifdef MIEEE x += w/x; *q -= 0x10; x += w/x; *q -= 0x10; x += w/x; *q -= 0x10; #endif return(x); } Math-Cephes-0.5306/libmd/cbrt.c0000644000175000017500000000475114757021403015770 0ustar shlomifshlomif/* md_cbrt.c * * Cube root * * * * SYNOPSIS: * * double x, y, md_cbrt(); * * y = md_cbrt( x ); * * * * DESCRIPTION: * * Returns the cube root of the argument, which may be negative. * * Range reduction involves determining the power of 2 of * the argument. A polynomial of degree 2 applied to the * mantissa, and multiplication by the cube root of 1, 2, or 4 * approximates the root to within about 0.1%. Then Newton's * iteration is used three times to converge to an accurate * result. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,10 200000 1.8e-17 6.2e-18 * IEEE 0,1e308 30000 1.5e-16 5.0e-17 * */ /* md_cbrt.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1991, 2000 by Stephen L. Moshier */ #include "mconf.h" static double CBRT2 = 1.2599210498948731647672; static double CBRT4 = 1.5874010519681994747517; static double CBRT2I = 0.79370052598409973737585; static double CBRT4I = 0.62996052494743658238361; #ifdef ANSIPROT extern double md_frexp ( double, int * ); extern double md_ldexp ( double, int ); extern int isnan ( double ); extern int isfinite ( double ); #else double md_frexp(), md_ldexp(); int isnan(), isfinite(); #endif double md_cbrt(x) double x; { int e, rem, sign; double z; #ifdef NANS if( isnan(x) ) return x; #endif #ifdef INFINITIES if( !isfinite(x) ) return x; #endif if( x == 0 ) return( x ); if( x > 0 ) sign = 1; else { sign = -1; x = -x; } z = x; /* extract power of 2, leaving * mantissa between 0.5 and 1 */ x = md_frexp( x, &e ); /* Approximate cube root of number between .5 and 1, * peak relative error = 9.2e-6 */ x = (((-1.3466110473359520655053e-1 * x + 5.4664601366395524503440e-1) * x - 9.5438224771509446525043e-1) * x + 1.1399983354717293273738e0 ) * x + 4.0238979564544752126924e-1; /* exponent divided by 3 */ if( e >= 0 ) { rem = e; e /= 3; rem -= 3*e; if( rem == 1 ) x *= CBRT2; else if( rem == 2 ) x *= CBRT4; } /* argument less than 1 */ else { e = -e; rem = e; e /= 3; rem -= 3*e; if( rem == 1 ) x *= CBRT2I; else if( rem == 2 ) x *= CBRT4I; e = -e; } /* multiply by power of 2 */ x = md_ldexp( x, e ); /* Newton iteration */ x -= ( x - (z/(x*x)) )*0.33333333333333333333; #ifdef DEC x -= ( x - (z/(x*x)) )/3.0; #else x -= ( x - (z/(x*x)) )*0.33333333333333333333; #endif if( sign < 0 ) x = -x; return(x); } Math-Cephes-0.5306/libmd/igam.c0000644000175000017500000000760714757021403015756 0ustar shlomifshlomif/* igam.c * * Incomplete md_gamma integral * * * * SYNOPSIS: * * double a, x, y, igam(); * * y = igam( a, x ); * * DESCRIPTION: * * The function is defined by * * x * - * 1 | | -t a-1 * igam(a,x) = ----- | e t dt. * - | | * | (a) - * 0 * * * In this implementation both arguments must be positive. * The integral is evaluated by either a power series or * continued fraction expansion, depending on the relative * values of a and x. * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0,30 200000 3.6e-14 2.9e-15 * IEEE 0,100 300000 9.9e-14 1.5e-14 */ /* igamc() * * Complemented incomplete md_gamma integral * * * * SYNOPSIS: * * double a, x, y, igamc(); * * y = igamc( a, x ); * * DESCRIPTION: * * The function is defined by * * * igamc(a,x) = 1 - igam(a,x) * * inf. * - * 1 | | -t a-1 * = ----- | e t dt. * - | | * | (a) - * x * * * In this implementation both arguments must be positive. * The integral is evaluated by either a power series or * continued fraction expansion, depending on the relative * values of a and x. * * ACCURACY: * * Tested at random a, x. * a x Relative error: * arithmetic domain domain # trials peak rms * IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15 * IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15 */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1985, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double lgam ( double ); extern double md_exp ( double ); extern double md_log ( double ); extern double md_fabs ( double ); extern double igam ( double, double ); extern double igamc ( double, double ); #else double lgam(), md_exp(), md_log(), md_fabs(), igam(), igamc(); #endif extern double MACHEP, MAXLOG; static double big = 4.503599627370496e15; static double biginv = 2.22044604925031308085e-16; double igamc( a, x ) double a, x; { double ans, ax, c, yc, r, t, y, z; double pk, pkm1, pkm2, qk, qkm1, qkm2; if( (x <= 0) || ( a <= 0) ) return( 1.0 ); if( (x < 1.0) || (x < a) ) return( 1.0 - igam(a,x) ); ax = a * md_log(x) - x - lgam(a); if( ax < -MAXLOG ) { mtherr( "igamc", UNDERFLOW ); return( 0.0 ); } ax = md_exp(ax); /* continued fraction */ y = 1.0 - a; z = x + y + 1.0; c = 0.0; pkm2 = 1.0; qkm2 = x; pkm1 = x + 1.0; qkm1 = z * x; ans = pkm1/qkm1; do { c += 1.0; y += 1.0; z += 2.0; yc = y * c; pk = pkm1 * z - pkm2 * yc; qk = qkm1 * z - qkm2 * yc; if( qk != 0 ) { r = pk/qk; t = md_fabs( (ans - r)/r ); ans = r; } else t = 1.0; pkm2 = pkm1; pkm1 = pk; qkm2 = qkm1; qkm1 = qk; if( md_fabs(pk) > big ) { pkm2 *= biginv; pkm1 *= biginv; qkm2 *= biginv; qkm1 *= biginv; } } while( t > MACHEP ); return( ans * ax ); } /* left tail of incomplete md_gamma function: * * inf. k * a -x - x * x e > ---------- * - - * k=0 | (a+k+1) * */ double igam( a, x ) double a, x; { double ans, ax, c, r; if( (x <= 0) || ( a <= 0) ) return( 0.0 ); if( (x > 1.0) && (x > a ) ) return( 1.0 - igamc(a,x) ); /* Compute x**a * md_exp(-x) / md_gamma(a) */ ax = a * md_log(x) - x - lgam(a); if( ax < -MAXLOG ) { mtherr( "igam", UNDERFLOW ); return( 0.0 ); } ax = md_exp(ax); /* power series */ r = a; c = 1.0; ans = 1.0; do { r += 1.0; c *= x/r; ans += c; } while( c/ans > MACHEP ); return( ans * ax/a ); } Math-Cephes-0.5306/libmd/arcdot.c0000644000175000017500000000410414757021403016302 0ustar shlomifshlomif/* arcdot.c * * Angle between two vectors * * * * * SYNOPSIS: * * double p[3], q[3], arcdot(); * * y = arcdot( p, q ); * * * * DESCRIPTION: * * For two vectors p, q, the angle A between them is given by * * p.q / (|p| |q|) = md_cos A . * * where "." represents inner product, "|x|" the length of vector x. * If the angle is small, an expression in md_sin A is preferred. * Set r = q - p. Then * * p.q = p.p + p.r , * * |p|^2 = p.p , * * |q|^2 = p.p + 2 p.r + r.r , * * p.p^2 + 2 p.p p.r + p.r^2 * md_cos^2 A = ---------------------------- * p.p (p.p + 2 p.r + r.r) * * p.p + 2 p.r + p.r^2 / p.p * = --------------------------- , * p.p + 2 p.r + r.r * * md_sin^2 A = 1 - md_cos^2 A * * r.r - p.r^2 / p.p * = -------------------- * p.p + 2 p.r + r.r * * = (r.r - p.r^2 / p.p) / q.q . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -1, 1 10^6 1.7e-16 4.2e-17 * */ /* Cephes Math Library Release 2.3: November, 1995 Copyright 1995 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double sqrt ( double ); extern double md_acos ( double ); extern double md_asin ( double ); extern double md_atan ( double ); #else double sqrt(), md_acos(), md_asin(), md_atan(); #endif extern double PI; double arcdot(p,q) double p[], q[]; { double pp, pr, qq, rr, rt, pt, qt, pq; int i; pq = 0.0; qq = 0.0; pp = 0.0; pr = 0.0; rr = 0.0; for (i=0; i<3; i++) { pt = p[i]; qt = q[i]; pq += pt * qt; qq += qt * qt; pp += pt * pt; rt = qt - pt; pr += pt * rt; rr += rt * rt; } if (rr == 0.0 || pp == 0.0 || qq == 0.0) return 0.0; rt = (rr - (pr * pr) / pp) / qq; if (rt <= 0.75) { rt = sqrt(rt); qt = md_asin(rt); if (pq < 0.0) qt = PI - qt; } else { pt = pq / sqrt(pp*qq); qt = md_acos(pt); } return qt; } Math-Cephes-0.5306/libmd/euclid.c0000644000175000017500000000765014757021403016304 0ustar shlomifshlomif/* euclid.c * * Rational arithmetic routines * * * * SYNOPSIS: * * * typedef struct * { * double n; numerator * double d; denominator * }fract; * * radd( a, b, c ) c = b + a * rsub( a, b, c ) c = b - a * rmul( a, b, c ) c = b * a * rdiv( a, b, c ) c = b / a * euclid( &n, &d ) Reduce n/d to lowest terms, * return greatest common divisor. * * Arguments of the routines are pointers to the structures. * The double precision numbers are assumed, without checking, * to be integer valued. Overflow conditions are reported. */ #include "mconf.h" #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_floor ( double ); double euclid( double *, double * ); #else double md_fabs(), md_floor(), euclid(); #endif extern double MACHEP; #define BIG (1.0/MACHEP) typedef struct { double n; /* numerator */ double d; /* denominator */ }fract; /* Add fractions. */ void radd( f1, f2, f3 ) fract *f1, *f2, *f3; { double gcd, d1, d2, gcn, n1, n2; n1 = f1->n; d1 = f1->d; n2 = f2->n; d2 = f2->d; if( n1 == 0.0 ) { f3->n = n2; f3->d = d2; return; } if( n2 == 0.0 ) { f3->n = n1; f3->d = d1; return; } gcd = euclid( &d1, &d2 ); /* common divisors of denominators */ gcn = euclid( &n1, &n2 ); /* common divisors of numerators */ /* Note, factoring the numerators * makes overflow slightly less likely. */ f3->n = ( n1 * d2 + n2 * d1) * gcn; f3->d = d1 * d2 * gcd; euclid( &f3->n, &f3->d ); } /* Subtract fractions. */ void rsub( f1, f2, f3 ) fract *f1, *f2, *f3; { double gcd, d1, d2, gcn, n1, n2; n1 = f1->n; d1 = f1->d; n2 = f2->n; d2 = f2->d; if( n1 == 0.0 ) { f3->n = n2; f3->d = d2; return; } if( n2 == 0.0 ) { f3->n = -n1; f3->d = d1; return; } gcd = euclid( &d1, &d2 ); gcn = euclid( &n1, &n2 ); f3->n = (n2 * d1 - n1 * d2) * gcn; f3->d = d1 * d2 * gcd; euclid( &f3->n, &f3->d ); } /* Multiply fractions. */ void rmul( ff1, ff2, ff3 ) fract *ff1, *ff2, *ff3; { double d1, d2, n1, n2; n1 = ff1->n; d1 = ff1->d; n2 = ff2->n; d2 = ff2->d; if( (n1 == 0.0) || (n2 == 0.0) ) { ff3->n = 0.0; ff3->d = 1.0; return; } euclid( &n1, &d2 ); /* cross cancel common divisors */ euclid( &n2, &d1 ); ff3->n = n1 * n2; ff3->d = d1 * d2; /* Report overflow. */ if( (md_fabs(ff3->n) >= BIG) || (md_fabs(ff3->d) >= BIG) ) { mtherr( "rmul", OVERFLOW ); return; } /* euclid( &ff3->n, &ff3->d );*/ } /* Divide fractions. */ void rdiv( ff1, ff2, ff3 ) fract *ff1, *ff2, *ff3; { double d1, d2, n1, n2; n1 = ff1->d; /* Invert ff1, then multiply */ d1 = ff1->n; if( d1 < 0.0 ) { /* keep denominator positive */ n1 = -n1; d1 = -d1; } n2 = ff2->n; d2 = ff2->d; if( (n1 == 0.0) || (n2 == 0.0) ) { ff3->n = 0.0; ff3->d = 1.0; return; } euclid( &n1, &d2 ); /* cross cancel any common divisors */ euclid( &n2, &d1 ); ff3->n = n1 * n2; ff3->d = d1 * d2; /* Report overflow. */ if( (md_fabs(ff3->n) >= BIG) || (md_fabs(ff3->d) >= BIG) ) { mtherr( "rdiv", OVERFLOW ); return; } /* euclid( &ff3->n, &ff3->d );*/ } /* Euclidean algorithm * reduces fraction to lowest terms, * returns greatest common divisor. */ double euclid( num, den ) double *num, *den; { double n, d, q, r; n = *num; /* Numerator. */ d = *den; /* Denominator. */ /* Make numbers positive, locally. */ if( n < 0.0 ) n = -n; if( d < 0.0 ) d = -d; /* Abort if numbers are too big for integer arithmetic. */ if( (n >= BIG) || (d >= BIG) ) { mtherr( "euclid", OVERFLOW ); return(1.0); } /* Divide by zero, gcd = 1. */ if(d == 0.0) return( 1.0 ); /* Zero. Return 0/1, gcd = denominator. */ if(n == 0.0) { /* if( *den < 0.0 ) *den = -1.0; else *den = 1.0; */ *den = 1.0; return( d ); } while( d > 0.5 ) { /* Find integer part of n divided by d. */ q = md_floor( n/d ); /* Find remainder after dividing n by d. */ r = n - d * q; /* The next fraction is d/r. */ n = d; d = r; } if( n < 0.0 ) mtherr( "euclid", UNDERFLOW ); *num /= n; *den /= n; return( n ); } Math-Cephes-0.5306/libmd/powi.c0000644000175000017500000000566414757021403016020 0ustar shlomifshlomif/* md_powi.c * * Real raised to integer power * * * * SYNOPSIS: * * double x, y, md_powi(); * int n; * * y = md_powi( x, n ); * * * * DESCRIPTION: * * Returns argument x raised to the nth power. * The routine efficiently decomposes n as a sum of powers of * two. The desired power is a product of two-to-the-kth * powers of x. Thus to compute the 32767 power of x requires * 28 multiplications instead of 32767 multiplications. * * * * ACCURACY: * * * Relative error: * arithmetic x domain n domain # trials peak rms * DEC .04,26 -26,26 100000 2.7e-16 4.3e-17 * IEEE .04,26 -26,26 50000 2.0e-15 3.8e-16 * IEEE 1,2 -1022,1023 50000 8.6e-14 1.6e-14 * * Returns MAXNUM on overflow, zero on underflow. * */ /* md_powi.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double md_log ( double ); extern double md_frexp ( double, int * ); extern int signbit ( double ); #else double md_log(), md_frexp(); int signbit(); #endif extern double NEGZERO, INFINITY, MAXNUM, MAXLOG, MINLOG, LOGE2; double md_powi( x, nn ) double x; int nn; { int n, e, sign, asign, lx; double w, y, s; /* See md_pow.c for these tests. */ if( x == 0.0 ) { if( nn == 0 ) return( 1.0 ); else if( nn < 0 ) return( INFINITY ); else { if( nn & 1 ) return( x ); else return( 0.0 ); } } if( nn == 0 ) return( 1.0 ); if( nn == -1 ) return( 1.0/x ); if( x < 0.0 ) { asign = -1; x = -x; } else asign = 0; if( nn < 0 ) { sign = -1; n = -nn; } else { sign = 1; n = nn; } /* Even power will be positive. */ if( (n & 1) == 0 ) asign = 0; /* Overflow detection */ /* Calculate approximate logarithm of answer */ s = md_frexp( x, &lx ); e = (lx - 1)*n; if( (e == 0) || (e > 64) || (e < -64) ) { s = (s - 7.0710678118654752e-1) / (s + 7.0710678118654752e-1); s = (2.9142135623730950 * s - 0.5 + lx) * nn * LOGE2; } else { s = LOGE2 * e; } if( s > MAXLOG ) { mtherr( "md_powi", OVERFLOW ); y = INFINITY; goto done; } #if DENORMAL if( s < MINLOG ) { y = 0.0; goto done; } /* Handle tiny denormal answer, but with less accuracy * since roundoff error in 1.0/x will be amplified. * The precise demarcation should be the gradual underflow threshold. */ if( (s < (-MAXLOG+2.0)) && (sign < 0) ) { x = 1.0/x; sign = -sign; } #else /* do not produce denormal answer */ if( s < -MAXLOG ) return(0.0); #endif /* First bit of the power */ if( n & 1 ) y = x; else y = 1.0; w = x; n >>= 1; while( n ) { w = w * w; /* arg to the 2-to-the-kth power */ if( n & 1 ) /* if that bit is set, then include in product */ y *= w; n >>= 1; } if( sign < 0 ) y = 1.0/y; done: if( asign ) { /* odd power of negative number */ if( y == 0.0 ) y = NEGZERO; else y = -y; } return(y); } Math-Cephes-0.5306/libmd/log.c0000644000175000017500000001517614757021403015622 0ustar shlomifshlomif/* md_log.c * * Natural logarithm * * * * SYNOPSIS: * * double x, y, md_log(); * * y = md_log( x ); * * * * DESCRIPTION: * * Returns the base e (2.718...) logarithm of x. * * The argument is separated into its exponent and fractional * parts. If the exponent is between -1 and +1, the logarithm * of the fraction is approximated by * * md_log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). * * Otherwise, setting z = 2(x-1)/x+1), * * md_log(x) = z + z**3 P(z)/Q(z). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0.5, 2.0 150000 1.44e-16 5.06e-17 * IEEE +-MAXNUM 30000 1.20e-16 4.78e-17 * DEC 0, 10 170000 1.8e-17 6.3e-18 * * In the tests over the interval [+-MAXNUM], the logarithms * of the random arguments were uniformly distributed over * [0, MAXLOG]. * * ERROR MESSAGES: * * md_log singularity: x = 0; returns -INFINITY * md_log domain: x < 0; returns NAN */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" static char fname[] = {"md_log"}; /* Coefficients for md_log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) * 1/sqrt(2) <= x < sqrt(2) */ #ifdef UNK static double P[] = { 1.01875663804580931796E-4, 4.97494994976747001425E-1, 4.70579119878881725854E0, 1.44989225341610930846E1, 1.79368678507819816313E1, 7.70838733755885391666E0, }; static double Q[] = { /* 1.00000000000000000000E0, */ 1.12873587189167450590E1, 4.52279145837532221105E1, 8.29875266912776603211E1, 7.11544750618563894466E1, 2.31251620126765340583E1, }; #endif #ifdef DEC static unsigned short P[] = { 0037777,0127270,0162547,0057274, 0041001,0054665,0164317,0005341, 0041451,0034104,0031640,0105773, 0041677,0011276,0123617,0160135, 0041701,0126603,0053215,0117250, 0041420,0115777,0135206,0030232, }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0041220,0144332,0045272,0174241, 0041742,0164566,0035720,0130431, 0042246,0126327,0166065,0116357, 0042372,0033420,0157525,0124560, 0042271,0167002,0066537,0172303, 0041730,0164777,0113711,0044407, }; #endif #ifdef IBMPC static unsigned short P[] = { 0x1bb0,0x93c3,0xb4c2,0x3f1a, 0x52f2,0x3f56,0xd6f5,0x3fdf, 0x6911,0xed92,0xd2ba,0x4012, 0xeb2e,0xc63e,0xff72,0x402c, 0xc84d,0x924b,0xefd6,0x4031, 0xdcf8,0x7d7e,0xd563,0x401e, }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xef8e,0xae97,0x9320,0x4026, 0xc033,0x4e19,0x9d2c,0x4046, 0xbdbd,0xa326,0xbf33,0x4054, 0xae21,0xeb5e,0xc9e2,0x4051, 0x25b2,0x9e1f,0x200a,0x4037, }; #endif #ifdef MIEEE static unsigned short P[] = { 0x3f1a,0xb4c2,0x93c3,0x1bb0, 0x3fdf,0xd6f5,0x3f56,0x52f2, 0x4012,0xd2ba,0xed92,0x6911, 0x402c,0xff72,0xc63e,0xeb2e, 0x4031,0xefd6,0x924b,0xc84d, 0x401e,0xd563,0x7d7e,0xdcf8, }; static unsigned short Q[] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4026,0x9320,0xae97,0xef8e, 0x4046,0x9d2c,0x4e19,0xc033, 0x4054,0xbf33,0xa326,0xbdbd, 0x4051,0xc9e2,0xeb5e,0xae21, 0x4037,0x200a,0x9e1f,0x25b2, }; #endif /* Coefficients for md_log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/(x+1) * 1/sqrt(2) <= x < sqrt(2) */ #ifdef UNK static double R[3] = { -7.89580278884799154124E-1, 1.63866645699558079767E1, -6.41409952958715622951E1, }; static double S[3] = { /* 1.00000000000000000000E0,*/ -3.56722798256324312549E1, 3.12093766372244180303E2, -7.69691943550460008604E2, }; #endif #ifdef DEC static unsigned short R[12] = { 0140112,0020756,0161540,0072035, 0041203,0013743,0114023,0155527, 0141600,0044060,0104421,0050400, }; static unsigned short S[12] = { /*0040200,0000000,0000000,0000000,*/ 0141416,0130152,0017543,0064122, 0042234,0006000,0104527,0020155, 0142500,0066110,0146631,0174731, }; #endif #ifdef IBMPC static unsigned short R[12] = { 0x0e84,0xdc6c,0x443d,0xbfe9, 0x7b6b,0x7302,0x62fc,0x4030, 0x2a20,0x1122,0x0906,0xc050, }; static unsigned short S[12] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x6d0a,0x43ec,0xd60d,0xc041, 0xe40e,0x112a,0x8180,0x4073, 0x3f3b,0x19b3,0x0d89,0xc088, }; #endif #ifdef MIEEE static unsigned short R[12] = { 0xbfe9,0x443d,0xdc6c,0x0e84, 0x4030,0x62fc,0x7302,0x7b6b, 0xc050,0x0906,0x1122,0x2a20, }; static unsigned short S[12] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0xc041,0xd60d,0x43ec,0x6d0a, 0x4073,0x8180,0x112a,0xe40e, 0xc088,0x0d89,0x19b3,0x3f3b, }; #endif #ifdef ANSIPROT extern double md_frexp ( double, int * ); extern double md_ldexp ( double, int ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern int isnan ( double ); extern int isfinite ( double ); #else double md_frexp(), md_ldexp(), polevl(), p1evl(); int isnan(), isfinite(); #endif #define SQRTH 0.70710678118654752440 extern double INFINITY, NAN; double md_log(x) double x; { int e; #ifdef DEC short *q; #endif double y, z; #ifdef NANS if( isnan(x) ) return(x); #endif #ifdef INFINITIES if( x == INFINITY ) return(x); #endif /* Test for domain */ if( x <= 0.0 ) { if( x == 0.0 ) { mtherr( fname, SING ); return( -INFINITY ); } else { mtherr( fname, DOMAIN ); return( NAN ); } } /* separate mantissa from exponent */ #ifdef DEC q = (short *)&x; e = *q; /* short containing exponent */ e = ((e >> 7) & 0377) - 0200; /* the exponent */ *q &= 0177; /* strip exponent from x */ *q |= 040000; /* x now between 0.5 and 1 */ #endif /* Note, md_frexp is used so that denormal numbers * will be handled properly. */ #ifdef IBMPC x = md_frexp( x, &e ); /* q = (short *)&x; q += 3; e = *q; e = ((e >> 4) & 0x0fff) - 0x3fe; *q &= 0x0f; *q |= 0x3fe0; */ #endif /* Equivalent C language standard library function: */ #ifdef UNK x = md_frexp( x, &e ); #endif #ifdef MIEEE x = md_frexp( x, &e ); #endif /* logarithm using md_log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/x+1) */ if( (e > 2) || (e < -2) ) { if( x < SQRTH ) { /* 2( 2x-1 )/( 2x+1 ) */ e -= 1; z = x - 0.5; y = 0.5 * z + 0.5; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5; z -= 0.5; y = 0.5 * x + 0.5; } x = z / y; /* rational form */ z = x*x; z = x * ( z * polevl( z, R, 2 ) / p1evl( z, S, 3 ) ); y = e; z = z - y * 2.121944400546905827679e-4; z = z + x; z = z + e * 0.693359375; goto ldone; } /* logarithm using md_log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if( x < SQRTH ) { e -= 1; x = md_ldexp( x, 1 ) - 1.0; /* 2x - 1 */ } else { x = x - 1.0; } /* rational form */ z = x*x; #if DEC y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 6 ) ); #else y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 5 ) ); #endif if( e ) y = y - e * 2.121944400546905827679e-4; y = y - md_ldexp( z, -1 ); /* y - 0.5 * z */ z = x + y; if( e ) z = z + e * 0.693359375; ldone: return( z ); } Math-Cephes-0.5306/libmd/airy.c0000644000175000017500000005643414757021403016007 0ustar shlomifshlomif/* airy.c * * Airy function * * * * SYNOPSIS: * * double x, ai, aip, bi, bip; * int airy(); * * airy( x, _&ai, _&aip, _&bi, _&bip ); * * * * DESCRIPTION: * * Solution of the differential equation * * y"(x) = xy. * * The function returns the two independent solutions Ai, Bi * and their first derivatives Ai'(x), Bi'(x). * * Evaluation is by power series summation for small x, * by rational minimax approximations for large x. * * * * ACCURACY: * Error criterion is absolute when function <= 1, relative * when function > 1, except * denotes relative error criterion. * For large negative x, the absolute error increases as x^1.5. * For large positive x, the relative error increases as x^1.5. * * Arithmetic domain function # trials peak rms * IEEE -10, 0 Ai 10000 1.6e-15 2.7e-16 * IEEE 0, 10 Ai 10000 2.3e-14* 1.8e-15* * IEEE -10, 0 Ai' 10000 4.6e-15 7.6e-16 * IEEE 0, 10 Ai' 10000 1.8e-14* 1.5e-15* * IEEE -10, 10 Bi 30000 4.2e-15 5.3e-16 * IEEE -10, 10 Bi' 30000 4.9e-15 7.3e-16 * DEC -10, 0 Ai 5000 1.7e-16 2.8e-17 * DEC 0, 10 Ai 5000 2.1e-15* 1.7e-16* * DEC -10, 0 Ai' 5000 4.7e-16 7.8e-17 * DEC 0, 10 Ai' 12000 1.8e-15* 1.5e-16* * DEC -10, 10 Bi 10000 5.5e-16 6.8e-17 * DEC -10, 10 Bi' 7000 5.3e-16 8.7e-17 * */ /* airy.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier */ #include "mconf.h" static double c1 = 0.35502805388781723926; static double c2 = 0.258819403792806798405; static double sqrt3 = 1.732050807568877293527; static double sqpii = 5.64189583547756286948E-1; extern double PI; extern double MAXNUM, MACHEP; #ifdef UNK #define MAXAIRY 25.77 #endif #ifdef DEC #define MAXAIRY 25.77 #endif #ifdef IBMPC #define MAXAIRY 103.892 #endif #ifdef MIEEE #define MAXAIRY 103.892 #endif #ifdef UNK static double AN[8] = { 3.46538101525629032477E-1, 1.20075952739645805542E1, 7.62796053615234516538E1, 1.68089224934630576269E2, 1.59756391350164413639E2, 7.05360906840444183113E1, 1.40264691163389668864E1, 9.99999999999999995305E-1, }; static double AD[8] = { 5.67594532638770212846E-1, 1.47562562584847203173E1, 8.45138970141474626562E1, 1.77318088145400459522E2, 1.64234692871529701831E2, 7.14778400825575695274E1, 1.40959135607834029598E1, 1.00000000000000000470E0, }; #endif #ifdef DEC static unsigned short AN[32] = { 0037661,0066561,0024675,0131301, 0041100,0017434,0034324,0101466, 0041630,0107450,0067427,0007430, 0042050,0013327,0071000,0034737, 0042037,0140642,0156417,0167366, 0041615,0011172,0075147,0051165, 0041140,0066152,0160520,0075146, 0040200,0000000,0000000,0000000, }; static unsigned short AD[32] = { 0040021,0046740,0011422,0064606, 0041154,0014640,0024631,0062450, 0041651,0003435,0101152,0106401, 0042061,0050556,0034605,0136602, 0042044,0036024,0152377,0151414, 0041616,0172247,0072216,0115374, 0041141,0104334,0124154,0166007, 0040200,0000000,0000000,0000000, }; #endif #ifdef IBMPC static unsigned short AN[32] = { 0xb658,0x2537,0x2dae,0x3fd6, 0x9067,0x871a,0x03e3,0x4028, 0xe1e3,0x0de2,0x11e5,0x4053, 0x073c,0xee40,0x02da,0x4065, 0xfddf,0x5ba1,0xf834,0x4063, 0xea4f,0x4f4c,0xa24f,0x4051, 0x0f4d,0x5c2a,0x0d8d,0x402c, 0x0000,0x0000,0x0000,0x3ff0, }; static unsigned short AD[32] = { 0x4d31,0x0262,0x29bc,0x3fe2, 0x2ca5,0x0533,0x8334,0x402d, 0x51a0,0xb04d,0x20e3,0x4055, 0xb7b0,0xc730,0x2a2d,0x4066, 0xfa61,0x9a9f,0x8782,0x4064, 0xd35f,0xee91,0xde94,0x4051, 0x9d81,0x950d,0x311b,0x402c, 0x0000,0x0000,0x0000,0x3ff0, }; #endif #ifdef MIEEE static unsigned short AN[32] = { 0x3fd6,0x2dae,0x2537,0xb658, 0x4028,0x03e3,0x871a,0x9067, 0x4053,0x11e5,0x0de2,0xe1e3, 0x4065,0x02da,0xee40,0x073c, 0x4063,0xf834,0x5ba1,0xfddf, 0x4051,0xa24f,0x4f4c,0xea4f, 0x402c,0x0d8d,0x5c2a,0x0f4d, 0x3ff0,0x0000,0x0000,0x0000, }; static unsigned short AD[32] = { 0x3fe2,0x29bc,0x0262,0x4d31, 0x402d,0x8334,0x0533,0x2ca5, 0x4055,0x20e3,0xb04d,0x51a0, 0x4066,0x2a2d,0xc730,0xb7b0, 0x4064,0x8782,0x9a9f,0xfa61, 0x4051,0xde94,0xee91,0xd35f, 0x402c,0x311b,0x950d,0x9d81, 0x3ff0,0x0000,0x0000,0x0000, }; #endif #ifdef UNK static double APN[8] = { 6.13759184814035759225E-1, 1.47454670787755323881E1, 8.20584123476060982430E1, 1.71184781360976385540E2, 1.59317847137141783523E2, 6.99778599330103016170E1, 1.39470856980481566958E1, 1.00000000000000000550E0, }; static double APD[8] = { 3.34203677749736953049E-1, 1.11810297306158156705E1, 7.11727352147859965283E1, 1.58778084372838313640E2, 1.53206427475809220834E2, 6.86752304592780337944E1, 1.38498634758259442477E1, 9.99999999999999994502E-1, }; #endif #ifdef DEC static unsigned short APN[32] = { 0040035,0017522,0065145,0054755, 0041153,0166556,0161471,0057174, 0041644,0016750,0034445,0046462, 0042053,0027515,0152316,0046717, 0042037,0050536,0067023,0023264, 0041613,0172252,0007240,0131055, 0041137,0023503,0052472,0002305, 0040200,0000000,0000000,0000000, }; static unsigned short APD[32] = { 0037653,0016276,0112106,0126625, 0041062,0162577,0067111,0111761, 0041616,0054160,0140004,0137455, 0042036,0143460,0104626,0157206, 0042031,0032330,0067131,0114260, 0041611,0054667,0147207,0134564, 0041135,0114412,0070653,0146015, 0040200,0000000,0000000,0000000, }; #endif #ifdef IBMPC static unsigned short APN[32] = { 0xab3e,0x4d4c,0xa3ea,0x3fe3, 0x2bcf,0xdc67,0x7dad,0x402d, 0xa9a6,0x0724,0x83bd,0x4054, 0xc9ba,0xba99,0x65e9,0x4065, 0x64d7,0xcdc2,0xea2b,0x4063, 0x1646,0x41d4,0x7e95,0x4051, 0x4099,0x6aa7,0xe4e8,0x402b, 0x0000,0x0000,0x0000,0x3ff0, }; static unsigned short APD[32] = { 0xd5b3,0xd288,0x6397,0x3fd5, 0x327e,0xedc9,0x5caf,0x4026, 0x97e6,0x1800,0xcb0e,0x4051, 0xdbd1,0x1132,0xd8e6,0x4063, 0x3316,0x0dcb,0x269b,0x4063, 0xf72f,0xf9d0,0x2b36,0x4051, 0x7982,0x4e35,0xb321,0x402b, 0x0000,0x0000,0x0000,0x3ff0, }; #endif #ifdef MIEEE static unsigned short APN[32] = { 0x3fe3,0xa3ea,0x4d4c,0xab3e, 0x402d,0x7dad,0xdc67,0x2bcf, 0x4054,0x83bd,0x0724,0xa9a6, 0x4065,0x65e9,0xba99,0xc9ba, 0x4063,0xea2b,0xcdc2,0x64d7, 0x4051,0x7e95,0x41d4,0x1646, 0x402b,0xe4e8,0x6aa7,0x4099, 0x3ff0,0x0000,0x0000,0x0000, }; static unsigned short APD[32] = { 0x3fd5,0x6397,0xd288,0xd5b3, 0x4026,0x5caf,0xedc9,0x327e, 0x4051,0xcb0e,0x1800,0x97e6, 0x4063,0xd8e6,0x1132,0xdbd1, 0x4063,0x269b,0x0dcb,0x3316, 0x4051,0x2b36,0xf9d0,0xf72f, 0x402b,0xb321,0x4e35,0x7982, 0x3ff0,0x0000,0x0000,0x0000, }; #endif #ifdef UNK static double BN16[5] = { -2.53240795869364152689E-1, 5.75285167332467384228E-1, -3.29907036873225371650E-1, 6.44404068948199951727E-2, -3.82519546641336734394E-3, }; static double BD16[5] = { /* 1.00000000000000000000E0,*/ -7.15685095054035237902E0, 1.06039580715664694291E1, -5.23246636471251500874E0, 9.57395864378383833152E-1, -5.50828147163549611107E-2, }; #endif #ifdef DEC static unsigned short BN16[20] = { 0137601,0124307,0010213,0035210, 0040023,0042743,0101621,0016031, 0137650,0164623,0036056,0074511, 0037203,0174525,0000473,0142474, 0136172,0130041,0066726,0064324, }; static unsigned short BD16[20] = { /*0040200,0000000,0000000,0000000,*/ 0140745,0002354,0044335,0055276, 0041051,0124717,0170130,0104013, 0140647,0070135,0046473,0103501, 0040165,0013745,0033324,0127766, 0137141,0117204,0076164,0033107, }; #endif #ifdef IBMPC static unsigned short BN16[20] = { 0x6751,0xe211,0x3518,0xbfd0, 0x2383,0x7072,0x68bc,0x3fe2, 0xcf29,0x6785,0x1d32,0xbfd5, 0x78a8,0xa027,0x7f2a,0x3fb0, 0xcd1b,0x2dba,0x5604,0xbf6f, }; static unsigned short BD16[20] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xab58,0x891b,0xa09d,0xc01c, 0x1101,0xfe0b,0x3539,0x4025, 0x70e8,0xa9a7,0xee0b,0xc014, 0x95ff,0xa6da,0xa2fc,0x3fee, 0x86c9,0x8f8e,0x33d0,0xbfac, }; #endif #ifdef MIEEE static unsigned short BN16[20] = { 0xbfd0,0x3518,0xe211,0x6751, 0x3fe2,0x68bc,0x7072,0x2383, 0xbfd5,0x1d32,0x6785,0xcf29, 0x3fb0,0x7f2a,0xa027,0x78a8, 0xbf6f,0x5604,0x2dba,0xcd1b, }; static unsigned short BD16[20] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0xc01c,0xa09d,0x891b,0xab58, 0x4025,0x3539,0xfe0b,0x1101, 0xc014,0xee0b,0xa9a7,0x70e8, 0x3fee,0xa2fc,0xa6da,0x95ff, 0xbfac,0x33d0,0x8f8e,0x86c9, }; #endif #ifdef UNK static double BPPN[5] = { 4.65461162774651610328E-1, -1.08992173800493920734E0, 6.38800117371827987759E-1, -1.26844349553102907034E-1, 7.62487844342109852105E-3, }; static double BPPD[5] = { /* 1.00000000000000000000E0,*/ -8.70622787633159124240E0, 1.38993162704553213172E1, -7.14116144616431159572E0, 1.34008595960680518666E0, -7.84273211323341930448E-2, }; #endif #ifdef DEC static unsigned short BPPN[20] = { 0037756,0050354,0167531,0135731, 0140213,0101216,0032767,0020375, 0040043,0104147,0106312,0177632, 0137401,0161574,0032015,0043714, 0036371,0155035,0143165,0142262, }; static unsigned short BPPD[20] = { /*0040200,0000000,0000000,0000000,*/ 0141013,0046265,0115005,0161053, 0041136,0061631,0072445,0156131, 0140744,0102145,0001127,0065304, 0040253,0103757,0146453,0102513, 0137240,0117200,0155402,0113500, }; #endif #ifdef IBMPC static unsigned short BPPN[20] = { 0x377b,0x9deb,0xca1d,0x3fdd, 0xe420,0xc6be,0x7051,0xbff1, 0x5ff3,0xf199,0x710c,0x3fe4, 0xa8fa,0x8681,0x3c6f,0xbfc0, 0xb896,0xb8ce,0x3b43,0x3f7f, }; static unsigned short BPPD[20] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xbc45,0xb340,0x6996,0xc021, 0xbb8b,0x2ea4,0xcc73,0x402b, 0xed59,0xa04a,0x908c,0xc01c, 0x70a9,0xf9a5,0x70fd,0x3ff5, 0x52e8,0x1b60,0x13d0,0xbfb4, }; #endif #ifdef MIEEE static unsigned short BPPN[20] = { 0x3fdd,0xca1d,0x9deb,0x377b, 0xbff1,0x7051,0xc6be,0xe420, 0x3fe4,0x710c,0xf199,0x5ff3, 0xbfc0,0x3c6f,0x8681,0xa8fa, 0x3f7f,0x3b43,0xb8ce,0xb896, }; static unsigned short BPPD[20] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0xc021,0x6996,0xb340,0xbc45, 0x402b,0xcc73,0x2ea4,0xbb8b, 0xc01c,0x908c,0xa04a,0xed59, 0x3ff5,0x70fd,0xf9a5,0x70a9, 0xbfb4,0x13d0,0x1b60,0x52e8, }; #endif #ifdef UNK static double AFN[9] = { -1.31696323418331795333E-1, -6.26456544431912369773E-1, -6.93158036036933542233E-1, -2.79779981545119124951E-1, -4.91900132609500318020E-2, -4.06265923594885404393E-3, -1.59276496239262096340E-4, -2.77649108155232920844E-6, -1.67787698489114633780E-8, }; static double AFD[9] = { /* 1.00000000000000000000E0,*/ 1.33560420706553243746E1, 3.26825032795224613948E1, 2.67367040941499554804E1, 9.18707402907259625840E0, 1.47529146771666414581E0, 1.15687173795188044134E-1, 4.40291641615211203805E-3, 7.54720348287414296618E-5, 4.51850092970580378464E-7, }; #endif #ifdef DEC static unsigned short AFN[36] = { 0137406,0155546,0124127,0033732, 0140040,0057564,0141263,0041222, 0140061,0071316,0013674,0175754, 0137617,0037522,0056637,0120130, 0137111,0075567,0121755,0166122, 0136205,0020016,0043317,0002201, 0135047,0001565,0075130,0002334, 0133472,0051700,0165021,0131551, 0131620,0020347,0132165,0013215, }; static unsigned short AFD[36] = { /*0040200,0000000,0000000,0000000,*/ 0041125,0131131,0025627,0067623, 0041402,0135342,0021703,0154315, 0041325,0162305,0016671,0120175, 0041022,0177101,0053114,0141632, 0040274,0153131,0147364,0114306, 0037354,0166545,0120042,0150530, 0036220,0043127,0000727,0130273, 0034636,0043275,0075667,0034733, 0032762,0112715,0146250,0142474, }; #endif #ifdef IBMPC static unsigned short AFN[36] = { 0xe6fb,0xd50a,0xdb6c,0xbfc0, 0x6852,0x9856,0x0bee,0xbfe4, 0x9f7d,0xc2f7,0x2e59,0xbfe6, 0xf40b,0x4bb3,0xe7ea,0xbfd1, 0xbd8a,0xf47d,0x2f6e,0xbfa9, 0xe090,0xc8d9,0xa401,0xbf70, 0x009c,0xaf4b,0xe06e,0xbf24, 0x366d,0x1d42,0x4a78,0xbec7, 0xa2d2,0xf68e,0x041c,0xbe52, }; static unsigned short AFD[36] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xedf2,0x2572,0xb64b,0x402a, 0x7b1a,0x4478,0x575c,0x4040, 0x3410,0xa3b7,0xbc98,0x403a, 0x9873,0x2ac9,0x5fc8,0x4022, 0x9319,0x39de,0x9acb,0x3ff7, 0x5a2b,0xb404,0x9dac,0x3fbd, 0xf617,0xe03a,0x08ca,0x3f72, 0xe73b,0xaf76,0xc8d7,0x3f13, 0x18a7,0xb995,0x52b9,0x3e9e, }; #endif #ifdef MIEEE static unsigned short AFN[36] = { 0xbfc0,0xdb6c,0xd50a,0xe6fb, 0xbfe4,0x0bee,0x9856,0x6852, 0xbfe6,0x2e59,0xc2f7,0x9f7d, 0xbfd1,0xe7ea,0x4bb3,0xf40b, 0xbfa9,0x2f6e,0xf47d,0xbd8a, 0xbf70,0xa401,0xc8d9,0xe090, 0xbf24,0xe06e,0xaf4b,0x009c, 0xbec7,0x4a78,0x1d42,0x366d, 0xbe52,0x041c,0xf68e,0xa2d2, }; static unsigned short AFD[36] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x402a,0xb64b,0x2572,0xedf2, 0x4040,0x575c,0x4478,0x7b1a, 0x403a,0xbc98,0xa3b7,0x3410, 0x4022,0x5fc8,0x2ac9,0x9873, 0x3ff7,0x9acb,0x39de,0x9319, 0x3fbd,0x9dac,0xb404,0x5a2b, 0x3f72,0x08ca,0xe03a,0xf617, 0x3f13,0xc8d7,0xaf76,0xe73b, 0x3e9e,0x52b9,0xb995,0x18a7, }; #endif #ifdef UNK static double AGN[11] = { 1.97339932091685679179E-2, 3.91103029615688277255E-1, 1.06579897599595591108E0, 9.39169229816650230044E-1, 3.51465656105547619242E-1, 6.33888919628925490927E-2, 5.85804113048388458567E-3, 2.82851600836737019778E-4, 6.98793669997260967291E-6, 8.11789239554389293311E-8, 3.41551784765923618484E-10, }; static double AGD[10] = { /* 1.00000000000000000000E0,*/ 9.30892908077441974853E0, 1.98352928718312140417E1, 1.55646628932864612953E1, 5.47686069422975497931E0, 9.54293611618961883998E-1, 8.64580826352392193095E-2, 4.12656523824222607191E-3, 1.01259085116509135510E-4, 1.17166733214413521882E-6, 4.91834570062930015649E-9, }; #endif #ifdef DEC static unsigned short AGN[44] = { 0036641,0124456,0167175,0157354, 0037710,0037250,0001441,0136671, 0040210,0066031,0150401,0123532, 0040160,0066545,0003570,0153133, 0037663,0171516,0072507,0170345, 0037201,0151011,0007510,0045702, 0036277,0172317,0104572,0101030, 0035224,0045663,0000160,0136422, 0033752,0074753,0047702,0135160, 0032256,0052225,0156550,0107103, 0030273,0142443,0166277,0071720, }; static unsigned short AGD[40] = { /*0040200,0000000,0000000,0000000,*/ 0041024,0170537,0117253,0055003, 0041236,0127256,0003570,0143240, 0041171,0004333,0172476,0160645, 0040657,0041161,0055716,0157161, 0040164,0046226,0006257,0063431, 0037261,0010357,0065445,0047563, 0036207,0034043,0057434,0116732, 0034724,0055416,0130035,0026377, 0033235,0041056,0154071,0023502, 0031250,0177071,0167254,0047242, }; #endif #ifdef IBMPC static unsigned short AGN[44] = { 0xbbde,0xddcf,0x3525,0x3f94, 0x37b7,0x0064,0x07d5,0x3fd9, 0x34eb,0x3a20,0x0d83,0x3ff1, 0x1acb,0xa0ef,0x0dac,0x3fee, 0xfe1d,0xcea8,0x7e69,0x3fd6, 0x0978,0x21e9,0x3a41,0x3fb0, 0x5043,0xf12f,0xfe99,0x3f77, 0x17a2,0x600e,0x8976,0x3f32, 0x574e,0x69f8,0x4f3d,0x3edd, 0x11c8,0xbbad,0xca92,0x3e75, 0xee7a,0x7d97,0x78a4,0x3df7, }; static unsigned short AGD[40] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x6b40,0xf3d5,0x9e2b,0x4022, 0x18d4,0xc0ef,0xd5d5,0x4033, 0xdc35,0x7ea7,0x211b,0x402f, 0xdbce,0x2b79,0xe84e,0x4015, 0xece3,0xc195,0x8992,0x3fee, 0xa9ee,0xed64,0x221d,0x3fb6, 0x93bb,0x6be3,0xe704,0x3f70, 0xa5a0,0xd603,0x8b61,0x3f1a, 0x24e8,0xdb07,0xa845,0x3eb3, 0x89d4,0x3dd5,0x1fc7,0x3e35, }; #endif #ifdef MIEEE static unsigned short AGN[44] = { 0x3f94,0x3525,0xddcf,0xbbde, 0x3fd9,0x07d5,0x0064,0x37b7, 0x3ff1,0x0d83,0x3a20,0x34eb, 0x3fee,0x0dac,0xa0ef,0x1acb, 0x3fd6,0x7e69,0xcea8,0xfe1d, 0x3fb0,0x3a41,0x21e9,0x0978, 0x3f77,0xfe99,0xf12f,0x5043, 0x3f32,0x8976,0x600e,0x17a2, 0x3edd,0x4f3d,0x69f8,0x574e, 0x3e75,0xca92,0xbbad,0x11c8, 0x3df7,0x78a4,0x7d97,0xee7a, }; static unsigned short AGD[40] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4022,0x9e2b,0xf3d5,0x6b40, 0x4033,0xd5d5,0xc0ef,0x18d4, 0x402f,0x211b,0x7ea7,0xdc35, 0x4015,0xe84e,0x2b79,0xdbce, 0x3fee,0x8992,0xc195,0xece3, 0x3fb6,0x221d,0xed64,0xa9ee, 0x3f70,0xe704,0x6be3,0x93bb, 0x3f1a,0x8b61,0xd603,0xa5a0, 0x3eb3,0xa845,0xdb07,0x24e8, 0x3e35,0x1fc7,0x3dd5,0x89d4, }; #endif #ifdef UNK static double APFN[9] = { 1.85365624022535566142E-1, 8.86712188052584095637E-1, 9.87391981747398547272E-1, 4.01241082318003734092E-1, 7.10304926289631174579E-2, 5.90618657995661810071E-3, 2.33051409401776799569E-4, 4.08718778289035454598E-6, 2.48379932900442457853E-8, }; static double APFD[9] = { /* 1.00000000000000000000E0,*/ 1.47345854687502542552E1, 3.75423933435489594466E1, 3.14657751203046424330E1, 1.09969125207298778536E1, 1.78885054766999417817E0, 1.41733275753662636873E-1, 5.44066067017226003627E-3, 9.39421290654511171663E-5, 5.65978713036027009243E-7, }; #endif #ifdef DEC static unsigned short APFN[36] = { 0037475,0150174,0071752,0166651, 0040142,0177621,0164246,0101757, 0040174,0142670,0106760,0006573, 0037715,0067570,0116274,0022404, 0037221,0074157,0053341,0117207, 0036301,0104257,0015075,0004777, 0035164,0057502,0164034,0001313, 0033611,0022254,0176000,0112565, 0031725,0055523,0025153,0166057, }; static unsigned short APFD[36] = { /*0040200,0000000,0000000,0000000,*/ 0041153,0140334,0130506,0061402, 0041426,0025551,0024440,0070611, 0041373,0134750,0047147,0176702, 0041057,0171532,0105430,0017674, 0040344,0174416,0001726,0047754, 0037421,0021207,0020167,0136264, 0036262,0043621,0151321,0124324, 0034705,0001313,0163733,0016407, 0033027,0166702,0150440,0170561, }; #endif #ifdef IBMPC static unsigned short APFN[36] = { 0x5db5,0x8e7d,0xba0f,0x3fc7, 0xd07e,0x3d14,0x5ff2,0x3fec, 0x01af,0x11be,0x98b7,0x3fef, 0x84a1,0x1397,0xadef,0x3fd9, 0x33d1,0xeadc,0x2f0d,0x3fb2, 0xa140,0xe347,0x3115,0x3f78, 0x8059,0x5d03,0x8be8,0x3f2e, 0x12af,0x9f80,0x2495,0x3ed1, 0x7d86,0x654d,0xab6a,0x3e5a, }; static unsigned short APFD[36] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xcc60,0x9628,0x781b,0x402d, 0x0e31,0x2524,0xc56d,0x4042, 0xffb8,0x09cc,0x773d,0x403f, 0x03f7,0x5163,0xfe6b,0x4025, 0xc9fd,0xc07a,0x9f21,0x3ffc, 0xf796,0xe40e,0x2450,0x3fc2, 0x351a,0x3a5a,0x48f2,0x3f76, 0x63a1,0x7cfb,0xa059,0x3f18, 0x1e2e,0x5a24,0xfdb8,0x3ea2, }; #endif #ifdef MIEEE static unsigned short APFN[36] = { 0x3fc7,0xba0f,0x8e7d,0x5db5, 0x3fec,0x5ff2,0x3d14,0xd07e, 0x3fef,0x98b7,0x11be,0x01af, 0x3fd9,0xadef,0x1397,0x84a1, 0x3fb2,0x2f0d,0xeadc,0x33d1, 0x3f78,0x3115,0xe347,0xa140, 0x3f2e,0x8be8,0x5d03,0x8059, 0x3ed1,0x2495,0x9f80,0x12af, 0x3e5a,0xab6a,0x654d,0x7d86, }; static unsigned short APFD[36] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x402d,0x781b,0x9628,0xcc60, 0x4042,0xc56d,0x2524,0x0e31, 0x403f,0x773d,0x09cc,0xffb8, 0x4025,0xfe6b,0x5163,0x03f7, 0x3ffc,0x9f21,0xc07a,0xc9fd, 0x3fc2,0x2450,0xe40e,0xf796, 0x3f76,0x48f2,0x3a5a,0x351a, 0x3f18,0xa059,0x7cfb,0x63a1, 0x3ea2,0xfdb8,0x5a24,0x1e2e, }; #endif #ifdef UNK static double APGN[11] = { -3.55615429033082288335E-2, -6.37311518129435504426E-1, -1.70856738884312371053E0, -1.50221872117316635393E0, -5.63606665822102676611E-1, -1.02101031120216891789E-1, -9.48396695961445269093E-3, -4.60325307486780994357E-4, -1.14300836484517375919E-5, -1.33415518685547420648E-7, -5.63803833958893494476E-10, }; static double APGD[11] = { /* 1.00000000000000000000E0,*/ 9.85865801696130355144E0, 2.16401867356585941885E1, 1.73130776389749389525E1, 6.17872175280828766327E0, 1.08848694396321495475E0, 9.95005543440888479402E-2, 4.78468199683886610842E-3, 1.18159633322838625562E-4, 1.37480673554219441465E-6, 5.79912514929147598821E-9, }; #endif #ifdef DEC static unsigned short APGN[44] = { 0137021,0124372,0176075,0075331, 0140043,0023330,0177672,0161655, 0140332,0131126,0010413,0171112, 0140300,0044263,0175560,0054070, 0140020,0044206,0142603,0073324, 0137321,0015130,0066144,0144033, 0136433,0061243,0175542,0103373, 0135361,0053721,0020441,0053203, 0134077,0141725,0160277,0130612, 0132417,0040372,0100363,0060200, 0130432,0175052,0171064,0034147, }; static unsigned short APGD[40] = { /*0040200,0000000,0000000,0000000,*/ 0041035,0136420,0030124,0140220, 0041255,0017432,0034447,0162256, 0041212,0100456,0154544,0006321, 0040705,0134026,0127154,0123414, 0040213,0051612,0044470,0172607, 0037313,0143362,0053273,0157051, 0036234,0144322,0054536,0007264, 0034767,0146170,0054265,0170342, 0033270,0102777,0167362,0073631, 0031307,0040644,0167103,0021763, }; #endif #ifdef IBMPC static unsigned short APGN[44] = { 0xaf5b,0x5f87,0x351f,0xbfa2, 0x5c76,0x1ff7,0x64db,0xbfe4, 0x7e49,0xc221,0x564a,0xbffb, 0x0b07,0x7f6e,0x0916,0xbff8, 0x6edb,0xd8b0,0x0910,0xbfe2, 0x9903,0x0d8c,0x234b,0xbfba, 0x50df,0x7f6c,0x6c54,0xbf83, 0x2ad0,0x2424,0x2afa,0xbf3e, 0xf631,0xbc17,0xf87a,0xbee7, 0x6c10,0x501e,0xe81f,0xbe81, 0x870d,0x5e46,0x5f45,0xbe03, }; static unsigned short APGD[40] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x9812,0x060a,0xb7a2,0x4023, 0xfc96,0x4724,0xa3e3,0x4035, 0x819a,0xdb2c,0x5025,0x4031, 0x94e2,0xd5cd,0xb702,0x4018, 0x1eb1,0x4927,0x6a71,0x3ff1, 0x7bc5,0x4ad7,0x78de,0x3fb9, 0xc1d7,0x4b2b,0x991a,0x3f73, 0xbe1c,0x0b16,0xf98f,0x3f1e, 0x4ef3,0xfdde,0x10bf,0x3eb7, 0x647e,0x9dc8,0xe834,0x3e38, }; #endif #ifdef MIEEE static unsigned short APGN[44] = { 0xbfa2,0x351f,0x5f87,0xaf5b, 0xbfe4,0x64db,0x1ff7,0x5c76, 0xbffb,0x564a,0xc221,0x7e49, 0xbff8,0x0916,0x7f6e,0x0b07, 0xbfe2,0x0910,0xd8b0,0x6edb, 0xbfba,0x234b,0x0d8c,0x9903, 0xbf83,0x6c54,0x7f6c,0x50df, 0xbf3e,0x2afa,0x2424,0x2ad0, 0xbee7,0xf87a,0xbc17,0xf631, 0xbe81,0xe81f,0x501e,0x6c10, 0xbe03,0x5f45,0x5e46,0x870d, }; static unsigned short APGD[40] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4023,0xb7a2,0x060a,0x9812, 0x4035,0xa3e3,0x4724,0xfc96, 0x4031,0x5025,0xdb2c,0x819a, 0x4018,0xb702,0xd5cd,0x94e2, 0x3ff1,0x6a71,0x4927,0x1eb1, 0x3fb9,0x78de,0x4ad7,0x7bc5, 0x3f73,0x991a,0x4b2b,0xc1d7, 0x3f1e,0xf98f,0x0b16,0xbe1c, 0x3eb7,0x10bf,0xfdde,0x4ef3, 0x3e38,0xe834,0x9dc8,0x647e, }; #endif #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_exp ( double ); extern double sqrt ( double ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_sin ( double ); extern double md_cos ( double ); #else double md_fabs(), md_exp(), sqrt(); double polevl(), p1evl(), md_sin(), md_cos(); #endif int airy( x, ai, aip, bi, bip ) double x, *ai, *aip, *bi, *bip; { double z, zz, t, f, g, uf, ug, k, zeta, theta; int domflg; domflg = 0; if( x > MAXAIRY ) { *ai = 0; *aip = 0; *bi = MAXNUM; *bip = MAXNUM; return(-1); } if( x < -2.09 ) { domflg = 15; t = sqrt(-x); zeta = -2.0 * x * t / 3.0; t = sqrt(t); k = sqpii / t; z = 1.0/zeta; zz = z * z; uf = 1.0 + zz * polevl( zz, AFN, 8 ) / p1evl( zz, AFD, 9 ); ug = z * polevl( zz, AGN, 10 ) / p1evl( zz, AGD, 10 ); theta = zeta + 0.25 * PI; f = md_sin( theta ); g = md_cos( theta ); *ai = k * (f * uf - g * ug); *bi = k * (g * uf + f * ug); uf = 1.0 + zz * polevl( zz, APFN, 8 ) / p1evl( zz, APFD, 9 ); ug = z * polevl( zz, APGN, 10 ) / p1evl( zz, APGD, 10 ); k = sqpii * t; *aip = -k * (g * uf + f * ug); *bip = k * (f * uf - g * ug); return(0); } if( x >= 2.09 ) /* md_cbrt(9) */ { domflg = 5; t = sqrt(x); zeta = 2.0 * x * t / 3.0; g = md_exp( zeta ); t = sqrt(t); k = 2.0 * t * g; z = 1.0/zeta; f = polevl( z, AN, 7 ) / polevl( z, AD, 7 ); *ai = sqpii * f / k; k = -0.5 * sqpii * t / g; f = polevl( z, APN, 7 ) / polevl( z, APD, 7 ); *aip = f * k; if( x > 8.3203353 ) /* zeta > 16 */ { f = z * polevl( z, BN16, 4 ) / p1evl( z, BD16, 5 ); k = sqpii * g; *bi = k * (1.0 + f) / t; f = z * polevl( z, BPPN, 4 ) / p1evl( z, BPPD, 5 ); *bip = k * t * (1.0 + f); return(0); } } f = 1.0; g = x; t = 1.0; uf = 1.0; ug = x; k = 1.0; z = x * x * x; while( t > MACHEP ) { uf *= z; k += 1.0; uf /=k; ug *= z; k += 1.0; ug /=k; uf /=k; f += uf; k += 1.0; ug /=k; g += ug; t = md_fabs(uf/f); } uf = c1 * f; ug = c2 * g; if( (domflg & 1) == 0 ) *ai = uf - ug; if( (domflg & 2) == 0 ) *bi = sqrt3 * (uf + ug); /* the deriviative of ai */ k = 4.0; uf = x * x/2.0; ug = z/3.0; f = uf; g = 1.0 + ug; uf /= 3.0; t = 1.0; while( t > MACHEP ) { uf *= z; ug /=k; k += 1.0; ug *= z; uf /=k; f += uf; k += 1.0; ug /=k; uf /=k; g += ug; k += 1.0; t = md_fabs(ug/g); } uf = c1 * f; ug = c2 * g; if( (domflg & 4) == 0 ) *aip = uf - ug; if( (domflg & 8) == 0 ) *bip = sqrt3 * (uf + ug); return(0); } Math-Cephes-0.5306/libmd/cpmul_wrap.c0000644000175000017500000000214514757022177017213 0ustar shlomifshlomif/* cpmul.c * * wrapper to cpmul.c * * * * SYNOPSIS: * * cpmul_wrap(ar, ai, da, br, bi, db, cr, ci, dc) * double ar[], ai[], br[], bi[], cr[], ci[] * int da, db, dc * */ /* cpmul */ #include "mconf.h" #ifdef ANSIPROT extern void * malloc (long); extern void free (void *); #else void * malloc(); void free (); #endif int cpmul_wrap( ar, ai, da, br, bi, db, cr, ci, dc ) double *ar, *ai, *br, *bi, *cr, *ci; int da, db; int *dc; { int i, ret; cmplx *a, *b, *c; extern int cpmul( cmplx a[], int da, cmplx b[], int db, cmplx c[], int *dc); a = (cmplx *) malloc (da * sizeof(cmplx)); b = (cmplx *) malloc (db * sizeof(cmplx)); c = (cmplx *) malloc (*dc * sizeof(cmplx)); for (i=0; i 0) return ret; for (i=0; i<=*dc; i++) { cr[i] = c[i].r; ci[i] = c[i].i; } free(a); free(b); free(c); return *dc; } Math-Cephes-0.5306/libmd/tan.c0000644000175000017500000001336414757021403015620 0ustar shlomifshlomif/* md_tan.c * * Circular tangent * * * * SYNOPSIS: * * double x, y, md_tan(); * * y = md_tan( x ); * * * * DESCRIPTION: * * Returns the circular tangent of the radian argument x. * * Range reduction is modulo pi/4. A rational function * x + x**3 P(x**2)/Q(x**2) * is employed in the basic interval [0, pi/4]. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC +-1.07e9 44000 4.1e-17 1.0e-17 * IEEE +-1.07e9 30000 2.9e-16 8.1e-17 * * ERROR MESSAGES: * * message condition value returned * md_tan total loss x > 1.073741824e9 0.0 * */ /* cot.c * * Circular cotangent * * * * SYNOPSIS: * * double x, y, cot(); * * y = cot( x ); * * * * DESCRIPTION: * * Returns the circular cotangent of the radian argument x. * * Range reduction is modulo pi/4. A rational function * x + x**3 P(x**2)/Q(x**2) * is employed in the basic interval [0, pi/4]. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE +-1.07e9 30000 2.9e-16 8.2e-17 * * * ERROR MESSAGES: * * message condition value returned * cot total loss x > 1.073741824e9 0.0 * cot singularity x = 0 INFINITY * */ /* Cephes Math Library Release 2.8: June, 2000 yright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double P[] = { -1.30936939181383777646E4, 1.15351664838587416140E6, -1.79565251976484877988E7 }; static double Q[] = { /* 1.00000000000000000000E0,*/ 1.36812963470692954678E4, -1.32089234440210967447E6, 2.50083801823357915839E7, -5.38695755929454629881E7 }; static double DP1 = 7.853981554508209228515625E-1; static double DP2 = 7.94662735614792836714E-9; static double DP3 = 3.06161699786838294307E-17; static double lossth = 1.073741824e9; #endif #ifdef DEC static unsigned short P[] = { 0143514,0113306,0111171,0174674, 0045214,0147545,0027744,0167346, 0146210,0177526,0114514,0105660 }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0043525,0142457,0072633,0025617, 0145241,0036742,0140525,0162256, 0046276,0146176,0013526,0143573, 0146515,0077401,0162762,0150607 }; /* 7.853981629014015197753906250000E-1 */ static unsigned short P1[] = {0040111,0007732,0120000,0000000,}; /* 4.960467869796758577649598009884E-10 */ static unsigned short P2[] = {0030410,0055060,0100000,0000000,}; /* 2.860594363054915898381331279295E-18 */ static unsigned short P3[] = {0021523,0011431,0105056,0001560,}; #define DP1 *(double *)P1 #define DP2 *(double *)P2 #define DP3 *(double *)P3 static double lossth = 1.073741824e9; #endif #ifdef IBMPC static unsigned short P[] = { 0x3f38,0xd24f,0x92d8,0xc0c9, 0x9ddd,0xa5fc,0x99ec,0x4131, 0x9176,0xd329,0x1fea,0xc171 }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x6572,0xeeb3,0xb8a5,0x40ca, 0xbc96,0x582a,0x27bc,0xc134, 0xd8ef,0xc2ea,0xd98f,0x4177, 0x5a31,0x3cbe,0xafe0,0xc189 }; /* 7.85398125648498535156E-1, 3.77489470793079817668E-8, 2.69515142907905952645E-15, */ static unsigned short P1[] = {0x0000,0x4000,0x21fb,0x3fe9}; static unsigned short P2[] = {0x0000,0x0000,0x442d,0x3e64}; static unsigned short P3[] = {0x5170,0x98cc,0x4698,0x3ce8}; #define DP1 *(double *)P1 #define DP2 *(double *)P2 #define DP3 *(double *)P3 static double lossth = 1.073741824e9; #endif #ifdef MIEEE static unsigned short P[] = { 0xc0c9,0x92d8,0xd24f,0x3f38, 0x4131,0x99ec,0xa5fc,0x9ddd, 0xc171,0x1fea,0xd329,0x9176 }; static unsigned short Q[] = { 0x40ca,0xb8a5,0xeeb3,0x6572, 0xc134,0x27bc,0x582a,0xbc96, 0x4177,0xd98f,0xc2ea,0xd8ef, 0xc189,0xafe0,0x3cbe,0x5a31 }; static unsigned short P1[] = { 0x3fe9,0x21fb,0x4000,0x0000 }; static unsigned short P2[] = { 0x3e64,0x442d,0x0000,0x0000 }; static unsigned short P3[] = { 0x3ce8,0x4698,0x98cc,0x5170, }; #define DP1 *(double *)P1 #define DP2 *(double *)P2 #define DP3 *(double *)P3 static double lossth = 1.073741824e9; #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_floor ( double ); extern double md_ldexp ( double, int ); extern int isnan ( double ); extern int isfinite ( double ); static double tancot(double, int); #else double polevl(), p1evl(), md_floor(), md_ldexp(); static double tancot(); int isnan(), isfinite(); #endif extern double PIO4; extern double INFINITY; extern double NAN; double md_tan(x) double x; { #ifdef MINUSZERO if( x == 0.0 ) return(x); #endif #ifdef NANS if( isnan(x) ) return(x); if( !isfinite(x) ) { mtherr( "md_tan", DOMAIN ); return(NAN); } #endif return( tancot(x,0) ); } double cot(x) double x; { if( x == 0.0 ) { mtherr( "cot", SING ); return( INFINITY ); } return( tancot(x,1) ); } static double tancot( xx, cotflg ) double xx; int cotflg; { double x, y, z, zz; int j, sign; /* make argument positive but save the sign */ if( xx < 0 ) { x = -xx; sign = -1; } else { x = xx; sign = 1; } if( x > lossth ) { if( cotflg ) mtherr( "cot", TLOSS ); else mtherr( "md_tan", TLOSS ); return(0.0); } /* compute x mod PIO4 */ y = md_floor( x/PIO4 ); /* strip high bits of integer part */ z = md_ldexp( y, -3 ); z = md_floor(z); /* integer part of y/8 */ z = y - md_ldexp( z, 3 ); /* y - 16 * (y/16) */ /* integer and fractional part modulo one octant */ j = z; /* map zeros and singularities to origin */ if( j & 1 ) { j += 1; y += 1.0; } z = ((x - y * DP1) - y * DP2) - y * DP3; zz = z * z; if( zz > 1.0e-14 ) y = z + z * (zz * polevl( zz, P, 2 )/p1evl(zz, Q, 4)); else y = z; if( j & 2 ) { if( cotflg ) y = -y; else y = -1.0/y; } else { if( cotflg ) y = 1.0/y; } if( sign < 0 ) y = -y; return( y ); } Math-Cephes-0.5306/libmd/ellik.c0000644000175000017500000000507514757021403016136 0ustar shlomifshlomif/* ellik.c * * Incomplete elliptic integral of the first kind * * * * SYNOPSIS: * * double phi, m, y, ellik(); * * y = ellik( phi, m ); * * * * DESCRIPTION: * * Approximates the integral * * * * phi * - * | | * | dt * F(phi_\m) = | ------------------ * | 2 * | | sqrt( 1 - m md_sin t ) * - * 0 * * of amplitude phi and modulus m, using the arithmetic - * geometric mean algorithm. * * * * * ACCURACY: * * Tested at random points with m in [0, 1] and phi as indicated. * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,10 200000 7.4e-16 1.0e-16 * * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ /* Incomplete elliptic integral of first kind */ #include "mconf.h" #ifdef ANSIPROT extern double sqrt ( double ); extern double md_fabs ( double ); extern double md_log ( double ); extern double md_tan ( double ); extern double md_atan ( double ); extern double md_floor ( double ); extern double ellpk ( double ); double ellik ( double, double ); #else double sqrt(), md_fabs(), md_log(), md_tan(), md_atan(), md_floor(), ellpk(); double ellik(); #endif extern double PI, PIO2, MACHEP, MAXNUM; double ellik( phi, m ) double phi, m; { double a, b, c, e, temp, t, K; int d, mod, sign, npio2; if( m == 0.0 ) return( phi ); a = 1.0 - m; if( a == 0.0 ) { if( md_fabs(phi) >= PIO2 ) { mtherr( "ellik", SING ); return( MAXNUM ); } return( md_log( md_tan( (PIO2 + phi)/2.0 ) ) ); } npio2 = md_floor( phi/PIO2 ); if( npio2 & 1 ) npio2 += 1; if( npio2 ) { K = ellpk( a ); phi = phi - npio2 * PIO2; } else K = 0.0; if( phi < 0.0 ) { phi = -phi; sign = -1; } else sign = 0; b = sqrt(a); t = md_tan( phi ); if( md_fabs(t) > 10.0 ) { /* Transform the amplitude */ e = 1.0/(b*t); /* ... but avoid multiple recursions. */ if( md_fabs(e) < 10.0 ) { e = md_atan(e); if( npio2 == 0 ) K = ellpk( a ); temp = K - ellik( e, m ); goto done; } } a = 1.0; c = sqrt(m); d = 1; mod = 0; while( md_fabs(c/a) > MACHEP ) { temp = b/a; phi = phi + md_atan(t*temp) + mod * PI; mod = (phi + PIO2)/PI; t = t * ( 1.0 + temp )/( 1.0 - temp * t * t ); c = ( a - b )/2.0; temp = sqrt( a * b ); a = ( a + b )/2.0; b = temp; d += d; } temp = (md_atan(t) + mod * PI)/(d * a); done: if( sign < 0 ) temp = -temp; temp += npio2 * K; return( temp ); } Math-Cephes-0.5306/libmd/protos.h0000644000175000017500000002024214757021403016362 0ustar shlomifshlomiftypedef struct { double n; double d; } fract; #include "mconf.h" extern double MACHEP; extern double MAXLOG; extern double MINLOG; extern double MAXNUM; extern double PI; extern double PIO2; extern double PIO4; extern double SQRT2; extern double SQRTH; extern double LOG2E; extern double SQ2OPI; extern double LOGE2; extern double LOGSQ2; extern double THPIO4; extern double TWOOPI; extern double acosh ( double x ); extern int airy ( double x, double *y, double *z, double *u, double *v ); extern double asin ( double x ); extern double acos ( double x ); extern double asinh ( double x ); extern double atan ( double x ); extern double atan2 ( double y, double x ); extern double atanh ( double x ); extern double bdtrc ( int k, int n, double p ); extern double bdtr ( int k, int n, double p ); extern double bdtri ( int k, int n, double y ); extern double beta ( double a, double b ); extern double lbeta ( double a, double b ); extern double btdtr ( double a, double b, double x ); extern double cbrt ( double x ); extern double chbevl ( double x, void *P, int n ); extern double chdtrc ( double df, double x ); extern double chdtr ( double df, double x ); extern double chdtri ( double df, double y ); extern void clog ( cmplx *z, cmplx *w ); extern void cexp ( cmplx *z, cmplx *w ); extern void csin ( cmplx *z, cmplx *w ); extern void ccos ( cmplx *z, cmplx *w ); extern void ctan ( cmplx *z, cmplx *w ); extern void ccot ( cmplx *z, cmplx *w ); extern void casin ( cmplx *z, cmplx *w ); extern void cacos ( cmplx *z, cmplx *w ); extern void catan ( cmplx *z, cmplx *w ); extern void csinh ( cmplx *z, cmplx *w ); extern void casinh ( cmplx *z, cmplx *w ); extern void ccosh ( cmplx *z, cmplx *w ); extern void cacosh ( cmplx *z, cmplx *w ); extern void ctanh ( cmplx *z, cmplx *w ); extern void catanh ( cmplx *z, cmplx *w ); extern void cpow ( cmplx *a, cmplx *z, cmplx *w ); extern void radd ( fract *a, fract *b, fract *c ); extern void rsub ( fract *a, fract *b, fract *c ); extern void rmul ( fract *a, fract *b, fract *c ); extern void rdiv ( fract *a, fract *b, fract *c ); extern double euclid ( double *x, double *y); extern void cadd ( cmplx *a, cmplx *b, cmplx *c ); extern void csub ( cmplx *a, cmplx *b, cmplx *c ); extern void cmul ( cmplx *a, cmplx *b, cmplx *c ); extern void cdiv ( cmplx *a, cmplx *b, cmplx *c ); extern void cmov ( void *a, void *b ); extern void cneg ( cmplx *a ); __declspec (dllexport) double cabs ( cmplx *z ); extern void csqrt ( cmplx *z, cmplx *w ); extern double hypot ( double x, double y ); extern double cosh ( double x ); extern double dawsn ( double xx ); extern double ellie ( double phi, double m ); extern double ellik ( double phi, double m ); extern double ellpe ( double x ); extern int ellpj ( double u, double m, double *x, double *y, double *z, double *a ); extern double ellpk ( double x ); extern double exp ( double x ); extern double exp10 ( double x ); /* extern double exp1m ( double x ); */ extern double exp2 ( double x ); extern double expn ( int n, double x ); extern double ei ( double x ); extern double fabs ( double x ); extern double fac ( int i ); extern double fdtrc ( int ia, int ib, double x ); extern double fdtr ( int ia, int ib, double x ); extern double fdtri ( int ia, int ib, double y ); extern double ceil ( double x ); extern double floor ( double x ); extern double frexp ( double x, int *n); /* extern double frexp ( double x, int *pw2 ); */ extern double ldexp ( double x, int pw2 ); /* extern int signbit ( double x ); */ /* extern int isnan ( double x ); */ /* extern int isfinite ( double x ); */ extern int fresnl ( double xxa, double *x, double *y); extern double gamma ( double x ); extern double lgam ( double x ); extern double gdtr ( double a, double b, double x ); extern double gdtrc ( double a, double b, double x ); extern double hyp2f1 ( double a, double b, double c, double x ); extern double hyperg ( double a, double b, double x ); extern double hyp2f0 ( double a, double b, double x, int type, double *y ); extern double i0 ( double x ); extern double i0e ( double x ); extern double i1 ( double x ); extern double i1e ( double x ); extern double igamc ( double a, double x ); extern double igam ( double a, double x ); extern double igami ( double a, double y0 ); extern double incbet ( double aa, double bb, double xx ); extern double incbi ( double aa, double bb, double yy0 ); extern double iv ( double v, double x ); extern double j0 ( double x ); extern double y0 ( double x ); extern double j1 ( double x ); extern double y1 ( double x ); extern double jn ( int n, double x ); extern double jv ( double n, double x ); extern double k0 ( double x ); extern double k0e ( double x ); extern double k1 ( double x ); extern double k1e ( double x ); extern double kn ( int nn, double x ); extern double log ( double x ); extern double log10 ( double x ); extern double log2 ( double x ); extern long lrand ( void ); extern long lsqrt ( long x ); extern int mtherr ( char *name, int code ); extern double polevl ( double x, void *P, int N ); extern double p1evl ( double x, void *P, int N ); extern double nbdtrc ( int k, int n, double p ); extern double nbdtr ( int k, int n, double p ); extern double nbdtri ( int k, int n, double p ); extern double ndtr ( double a ); extern double erfc ( double a ); extern double erf ( double x ); extern double ndtri ( double y0 ); extern double pdtrc ( int k, double m ); extern double pdtr ( int k, double m ); extern double pdtri ( int k, double y ); extern double pow ( double x, double y ); extern double powi ( double x, int nn ); extern double psi ( double x ); extern double rgamma ( double x ); extern double round ( double x ); extern int shichi ( double x, double *y, double *z ); extern int sici ( double x, double *y, double *z ); extern double sin ( double x ); extern double cos ( double x ); extern double radian ( double d, double m, double s ); /* extern int sincos ( double x, double *y, double *z, int flg ); */ extern double sindg ( double x ); extern double cosdg ( double x ); extern double sinh ( double x ); extern double spence ( double x ); extern double sqrt ( double x ); extern double stdtr ( int k, double t ); extern double stdtri ( int k, double p ); extern double onef2 ( double a, double b, double c, double x, double *y ); extern double threef0 ( double a, double b, double c, double x, double *y ); extern double struve ( double v, double x ); extern double tan ( double x ); extern double cot ( double x ); extern double tandg ( double x ); extern double cotdg ( double x ); extern double tanh ( double x ); extern double log1p ( double x ); extern double expm1 ( double x ); extern double cosm1 ( double x ); extern double yn ( int n, double x ); extern double yv ( double n, double x ); extern double zeta ( double x, double q ); extern double zetac ( double x ); extern int drand ( double *x ); extern double plancki(double w, double T); extern void polini( int maxdeg ); extern void polclr ( double * A, int n); extern void polmov ( double * A, int na, double * B ); extern void polmul ( double * A, int na, double * B, int nb, double * C ); extern int poldiv ( double * A, int na, double * B, int nb, double * C); extern void poladd ( double * A, int na, double * B, int nb, double * C ); extern void polsub ( double * A, int na, double * B, int nb, double * C ); extern void polsbt ( double * A, int na, double * B, int nb, double * C ); extern void polprt ( double * A, int na, int d ); extern double poleva (double * A, int na, double x); extern void polatn(double * A, double * B, double * C, int n); extern void polsqt(double * A, double * B, int n); extern void polsin(double * A, double * B, int n); extern void polcos(double * A, double * B, int n); extern int polrt_wrap(double * xcof, double * cof, int m, double * r, double * i); extern void bernum_wrap(double * num, double * den); extern double simpsn_wrap(double * f, int n, double h); extern int minv(double * A, double * X, int n, double * B, int * IPS); extern void mtransp(int n, double * A, double * X); extern void eigens(double * A, double * EV, double * E, int n); extern int simq(double * A, double * B, double * X, int n, int flag, int * IPS); extern double polylog(int n, double x); extern double arcdot(double * p, double * q); extern double expx2(double x, int sign); Math-Cephes-0.5306/libmd/struve.c0000644000175000017500000001104014757021403016353 0ustar shlomifshlomif/* struve.c * * Struve function * * * * SYNOPSIS: * * double v, x, y, struve(); * * y = struve( v, x ); * * * * DESCRIPTION: * * Computes the Struve function Hv(x) of order v, argument x. * Negative x is rejected unless v is an integer. * * This module also contains the hypergeometric functions 1F2 * and 3F0 and a routine for the Bessel function Yv(x) with * noninteger v. * * * * ACCURACY: * * Not accurately characterized, but spot checked against tables. * */ /* Cephes Math Library Release 2.81: June, 2000 Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier */ #include "mconf.h" #define DEBUG 0 #ifdef ANSIPROT extern double md_gamma ( double ); extern double md_pow ( double, double ); extern double sqrt ( double ); extern double md_yn ( int, double ); extern double jv ( double, double ); extern double md_fabs ( double ); extern double md_floor ( double ); extern double md_sin ( double ); extern double md_cos ( double ); double yv ( double, double ); double onef2 (double, double, double, double, double * ); double threef0 (double, double, double, double, double * ); #else double md_gamma(), md_pow(), sqrt(), md_yn(), yv(), jv(), md_fabs(), md_floor(); double md_sin(), md_cos(); double onef2(), threef0(); #endif static double stop = 1.37e-17; extern double MACHEP; double onef2( a, b, c, x, err ) double a, b, c, x; double *err; { double n, a0, sum, t; double an, bn, cn, max, z; an = a; bn = b; cn = c; a0 = 1.0; sum = 1.0; n = 1.0; t = 1.0; max = 0.0; do { if( an == 0 ) goto done; if( bn == 0 ) goto error; if( cn == 0 ) goto error; if( (a0 > 1.0e34) || (n > 200) ) goto error; a0 *= (an * x) / (bn * cn * n); sum += a0; an += 1.0; bn += 1.0; cn += 1.0; n += 1.0; z = md_fabs( a0 ); if( z > max ) max = z; if( sum != 0 ) t = md_fabs( a0 / sum ); else t = z; } while( t > stop ); done: *err = md_fabs( MACHEP*max /sum ); #if DEBUG printf(" onef2 cancellation error %.5E\n", *err ); #endif goto xit; error: #if DEBUG printf("onef2 does not converge\n"); #endif *err = 1.0e38; xit: #if DEBUG printf("onef2( %.2E %.2E %.2E %.5E ) = %.3E %.6E\n", a, b, c, x, n, sum); #endif return(sum); } double threef0( a, b, c, x, err ) double a, b, c, x; double *err; { double n, a0, sum, t, conv, conv1; double an, bn, cn, max, z; an = a; bn = b; cn = c; a0 = 1.0; sum = 1.0; n = 1.0; t = 1.0; max = 0.0; conv = 1.0e38; conv1 = conv; do { if( an == 0.0 ) goto done; if( bn == 0.0 ) goto done; if( cn == 0.0 ) goto done; if( (a0 > 1.0e34) || (n > 200) ) goto error; a0 *= (an * bn * cn * x) / n; an += 1.0; bn += 1.0; cn += 1.0; n += 1.0; z = md_fabs( a0 ); if( z > max ) max = z; if( z >= conv ) { if( (z < max) && (z > conv1) ) goto done; } conv1 = conv; conv = z; sum += a0; if( sum != 0 ) t = md_fabs( a0 / sum ); else t = z; } while( t > stop ); done: t = md_fabs( MACHEP*max/sum ); #if DEBUG printf(" threef0 cancellation error %.5E\n", t ); #endif max = md_fabs( conv/sum ); if( max > t ) t = max; #if DEBUG printf(" threef0 convergence %.5E\n", max ); #endif goto xit; error: #if DEBUG printf("threef0 does not converge\n"); #endif t = 1.0e38; xit: #if DEBUG printf("threef0( %.2E %.2E %.2E %.5E ) = %.3E %.6E\n", a, b, c, x, n, sum); #endif *err = t; return(sum); } extern double PI; double struve( v, x ) double v, x; { double y, ya, f, g, h, t; double onef2err, threef0err; f = md_floor(v); if( (v < 0) && ( v-f == 0.5 ) ) { y = jv( -v, x ); f = 1.0 - f; g = 2.0 * md_floor(f/2.0); if( g != f ) y = -y; return(y); } t = 0.25*x*x; f = md_fabs(x); g = 1.5 * md_fabs(v); if( (f > 30.0) && (f > g) ) { onef2err = 1.0e38; y = 0.0; } else { y = onef2( 1.0, 1.5, 1.5+v, -t, &onef2err ); } if( (f < 18.0) || (x < 0.0) ) { threef0err = 1.0e38; ya = 0.0; } else { ya = threef0( 1.0, 0.5, 0.5-v, -1.0/t, &threef0err ); } f = sqrt( PI ); h = md_pow( 0.5*x, v-1.0 ); if( onef2err <= threef0err ) { g = md_gamma( v + 1.5 ); y = y * h * t / ( 0.5 * f * g ); return(y); } else { g = md_gamma( v + 0.5 ); ya = ya * h / ( f * g ); ya = ya + yv( v, x ); return(ya); } } /* Bessel function of noninteger order */ double yv( v, x ) double v, x; { double y, t; int n; y = md_floor( v ); if( y == v ) { n = v; y = md_yn( n, x ); return( y ); } t = PI * v; y = (md_cos(t) * jv( v, x ) - jv( -v, x ))/md_sin(t); return( y ); } /* Crossover points between ascending series and asymptotic series * for Struve function * * v x * * 0 19.2 * 1 18.95 * 2 19.15 * 3 19.3 * 5 19.7 * 10 21.35 * 20 26.35 * 30 32.31 * 40 40.0 */ Math-Cephes-0.5306/libmd/tanh.c0000644000175000017500000000505214757021403015763 0ustar shlomifshlomif/* md_tanh.c * * Hyperbolic tangent * * * * SYNOPSIS: * * double x, y, md_tanh(); * * y = md_tanh( x ); * * * * DESCRIPTION: * * Returns hyperbolic tangent of argument in the range MINLOG to * MAXLOG. * * A rational function is used for |x| < 0.625. The form * x + x**3 P(x)/Q(x) of Cody _& Waite is employed. * Otherwise, * md_tanh(x) = md_sinh(x)/md_cosh(x) = 1 - 2/(md_exp(2x) + 1). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -2,2 50000 3.3e-17 6.4e-18 * IEEE -2,2 30000 2.5e-16 5.8e-17 * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double P[] = { -9.64399179425052238628E-1, -9.92877231001918586564E1, -1.61468768441708447952E3 }; static double Q[] = { /* 1.00000000000000000000E0,*/ 1.12811678491632931402E2, 2.23548839060100448583E3, 4.84406305325125486048E3 }; #endif #ifdef DEC static unsigned short P[] = { 0140166,0161335,0053753,0075126, 0141706,0111520,0070463,0040552, 0142711,0153001,0101300,0025430 }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0041741,0117624,0051300,0156060, 0043013,0133720,0071251,0127717, 0043227,0060201,0021020,0020136 }; #endif #ifdef IBMPC static unsigned short P[] = { 0x6f4b,0xaafd,0xdc5b,0xbfee, 0x682d,0x0e26,0xd26a,0xc058, 0x0563,0x3058,0x3ac0,0xc099 }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x1b86,0x8a58,0x33f2,0x405c, 0x35fa,0x0e55,0x76fa,0x40a1, 0x040c,0x2442,0xec10,0x40b2 }; #endif #ifdef MIEEE static unsigned short P[] = { 0xbfee,0xdc5b,0xaafd,0x6f4b, 0xc058,0xd26a,0x0e26,0x682d, 0xc099,0x3ac0,0x3058,0x0563 }; static unsigned short Q[] = { 0x405c,0x33f2,0x8a58,0x1b86, 0x40a1,0x76fa,0x0e55,0x35fa, 0x40b2,0xec10,0x2442,0x040c }; #endif #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_exp ( double ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); #else double md_fabs(), md_exp(), polevl(), p1evl(); #endif extern double MAXLOG; double md_tanh(x) double x; { double s, z; #ifdef MINUSZERO if( x == 0.0 ) return(x); #endif z = md_fabs(x); if( z > 0.5 * MAXLOG ) { if( x > 0 ) return( 1.0 ); else return( -1.0 ); } if( z >= 0.625 ) { s = md_exp(2.0*z); z = 1.0 - 2.0/(s + 1.0); if( x < 0 ) z = -z; } else { if( x == 0.0 ) return(x); s = x * x; z = polevl( s, P, 2 )/p1evl(s, Q, 3); z = x * s * z; z = x + z; } return( z ); } Math-Cephes-0.5306/libmd/floor.3870000644000175000017500000000735714757021403016263 0ustar shlomifshlomif .file "floor.c" gcc2_compiled.: /* Caution, order of operands is reversed from usual Intel syntax */ .text .align 2 .globl _ceil _ceil: pushl %ebp movl %esp,%ebp pushl 12(%ebp) pushl 8(%ebp) call _floor fcoml 8(%ebp) fnstsw %ax andb $69,%ah cmpb $1,%ah jne L252 fld1 faddp %st,%st(1) L252: fldz fucom %st(1) fnstsw %ax andb $68,%ah xorb $64,%ah jne L255 fcompl 8(%ebp) fnstsw %ax andb $69,%ah jne L253 fstp %st(0) fldl _NEGZERO movl %ebp,%esp popl %ebp ret .align 4,0x90 L255: fstp %st(0) L253: movl %ebp,%esp popl %ebp ret .align 2 .globl _floor _floor: pushl %ebp movl %esp,%ebp subl $4,%esp fstcw -4(%ebp) fwait movw -4(%ebp),%ax andw $0xf3ff,%ax orw $0x400,%ax movw %ax,-2(%ebp) fldcw -2(%ebp) fldl 8(%ebp) frndint fldcw -4(%ebp) leave ret .align 2 .globl _frexp _frexp: pushl %ebp movl %esp,%ebp subl $8,%esp pushl %ebx fldl 8(%ebp) movl 16(%ebp),%ebx fldz fucomp %st(1) fnstsw %ax andb $68,%ah xorb $64,%ah jne L19 movl $0,(%ebx) jmp L27 .align 4,0x90 L19: fstpl -8(%ebp) leal -2(%ebp),%ecx movw -2(%ebp),%ax sarw $4,%ax movl %eax,%edx andl $2047,%edx jne L21 .align 2,0x90 L23: fldl -8(%ebp) fadd %st(0),%st fstpl -8(%ebp) decl %edx movw (%ecx),%ax sarw $4,%ax andl $2047,%eax je L23 addl %eax,%edx L21: addl $-1022,%edx movl %edx,(%ebx) andw $32783,(%ecx) orw $16352,(%ecx) fldl -8(%ebp) L27: movl -12(%ebp),%ebx movl %ebp,%esp popl %ebp ret .align 2 LC1: .long 0x0,0x3fe00000 .align 2 .globl _ldexp _ldexp: pushl %ebp movl %esp,%ebp subl $8,%esp fldl 8(%ebp) movl 16(%ebp),%edx fldz fucomp %st(1) fnstsw %ax andb $68,%ah xorb $64,%ah jne L29 movl %ebp,%esp popl %ebp ret .align 4,0x90 L53: fstp %st(1) fstp %st(1) fstp %st(1) movl %ebp,%esp popl %ebp ret .align 4,0x90 L29: fstl -8(%ebp) leal -2(%ebp),%ecx fld1 testw $32752,-2(%ebp) jne L51 fldl LC1 .align 2,0x90 L32: testl %edx,%edx jle L33 fxch %st(1) fadd %st(0),%st fxch %st(1) decl %edx L33: testl %edx,%edx jge L34 cmpl $-53,%edx jl L52 fmul %st,%st(1) incl %edx L34: fld %st(2) fmul %st(2),%st fstl -8(%ebp) testl %edx,%edx je L53 fstp %st(0) testw $32752,(%ecx) je L32 fstp %st(0) L51: fstp %st(0) fstp %st(0) movw (%ecx),%ax andw $32752,%ax sarw $4,%ax cwtl addl %edx,%eax cmpl $2046,%eax jle L38 fldl _MAXNUM fadd %st(0),%st movl %ebp,%esp popl %ebp ret .align 4,0x90 L38: testl %eax,%eax jg L39 cmpl $-53,%eax jge L40 jmp L49 .align 4,0x90 L52: fstp %st(0) fstp %st(0) fstp %st(0) L49: fldz movl %ebp,%esp popl %ebp ret .align 4,0x90 L40: andw $32783,(%ecx) orb $16,(%ecx) leal -1(%eax),%eax pushl %eax pushl $1073741824 pushl $0 call ldexp fmull (%ecx) movl %ebp,%esp popl %ebp ret .align 4,0x90 L39: andw $32783,(%ecx) andb $7,%ah salw $4,%ax orw %ax,(%ecx) fldl -8(%ebp) movl %ebp,%esp popl %ebp ret .align 4 .globl _signbit _signbit: pushl %ebp movl %esp,%ebp movl 12(%ebp),%eax shrl $31,%eax movl %ebp,%esp popl %ebp ret .align 4 .globl _isnan _isnan: pushl %ebp movl %esp,%ebp pushl %ebx movl 8(%ebp),%ecx movl 12(%ebp),%ebx movl %ebx,%edx andl $2146435072,%edx cmpl $2146435072,%edx jne L62 testl $1048575,%ebx jne L63 testl %ecx,%ecx je L62 L63: movl $1,%eax jmp L67 .align 4,0x90 L62: xorl %eax,%eax L67: movl -4(%ebp),%ebx movl %ebp,%esp popl %ebp ret .align 4 .globl _isfinite _isfinite: pushl %ebp movl %esp,%ebp movl 12(%ebp),%eax andl $2146435072,%eax cmpl $2146435072,%eax jne L70 xorl %eax,%eax movl %ebp,%esp popl %ebp ret .align 4,0x90 L70: movl $1,%eax movl %ebp,%esp popl %ebp ret .align 4 .globl _fmod _fmod: fldl 4(%esp) ftst fnstsw %ax sahf jz L82 fldl 12(%esp) ftst fnstsw %ax sahf jz L81 fxch %st(1) L80: fprem fnstsw %ax sahf jpe L80 L81: fstp %st(1) L82: ret Math-Cephes-0.5306/libmd/cpmul.c0000644000175000017500000000430014757021403016144 0ustar shlomifshlomif/* cpmul.c * * Multiply two polynomials with complex coefficients * * * * SYNOPSIS: * * typedef struct * { * double r; * double i; * }cmplx; * * cmplx a[], b[], c[]; * int da, db, dc; * * cpmul( a, da, b, db, c, &dc ); * * * * DESCRIPTION: * * The two argument polynomials are multiplied together, and * their product is placed in c. * * Each polynomial is represented by its coefficients stored * as an array of complex number structures (see the typedef). * The degree of a is da, which must be passed to the routine * as an argument; similarly the degree db of b is an argument. * Array a has da + 1 elements and array b has db + 1 elements. * Array c must have storage allocated for at least da + db + 1 * elements. The value da + db is returned in dc; this is * the degree of the product polynomial. * * Polynomial coefficients are stored in ascending order; i.e., * a(x) = a[0]*x**0 + a[1]*x**1 + ... + a[da]*x**da. * * * If desired, c may be the same as either a or b, in which * case the input argument array is replaced by the product * array (but only up to terms of degree da + db). * */ /* cpmul */ typedef struct { double r; double i; }cmplx; int cpmul( a, da, b, db, c, dc ) cmplx *a, *b, *c; int da, db; int *dc; { int i, j, k; cmplx y; register cmplx *pa, *pb, *pc; if( da > db ) /* Know which polynomial has higher degree */ { i = da; /* Swapping is OK because args are on the stack */ da = db; db = i; pa = a; a = b; b = pa; } k = da + db; *dc = k; /* Output the degree of the product */ pc = &c[db+1]; for( i=db+1; i<=k; i++ ) /* Clear high order terms of output */ { pc->r = 0; pc->i = 0; pc++; } /* To permit replacement of input, work backward from highest degree */ pb = &b[db]; for( j=0; j<=db; j++ ) { pa = &a[da]; pc = &c[k-j]; for( i=0; ir * pb->r - pa->i * pb->i; /* cmpx multiply */ y.i = pa->r * pb->i + pa->i * pb->r; pc->r += y.r; /* accumulate partial product */ pc->i += y.i; pa--; pc--; } y.r = pa->r * pb->r - pa->i * pb->i; /* replace last term, */ y.i = pa->r * pb->i + pa->i * pb->r; /* ...do not accumulate */ pc->r = y.r; pc->i = y.i; pb--; } return 0; } Math-Cephes-0.5306/libmd/cmplx.c0000644000175000017500000001723714757021403016164 0ustar shlomifshlomif/* cmplx.c * * Complex number arithmetic * * * * SYNOPSIS: * * typedef struct { * double r; real part * double i; imaginary part * }cmplx; * * cmplx *a, *b, *c; * * cadd( a, b, c ); c = b + a * csub( a, b, c ); c = b - a * cmul( a, b, c ); c = b * a * cdiv( a, b, c ); c = b / a * cneg( c ); c = -c * cmov( b, c ); c = b * * * * DESCRIPTION: * * Addition: * c.r = b.r + a.r * c.i = b.i + a.i * * Subtraction: * c.r = b.r - a.r * c.i = b.i - a.i * * Multiplication: * c.r = b.r * a.r - b.i * a.i * c.i = b.r * a.i + b.i * a.r * * Division: * d = a.r * a.r + a.i * a.i * c.r = (b.r * a.r + b.i * a.i)/d * c.i = (b.i * a.r - b.r * a.i)/d * ACCURACY: * * In DEC arithmetic, the test (1/z) * z = 1 had peak relative * error 3.1e-17, rms 1.2e-17. The test (y/z) * (z/y) = 1 had * peak relative error 8.3e-17, rms 2.1e-17. * * Tests in the rectangle {-10,+10}: * Relative error: * arithmetic function # trials peak rms * DEC cadd 10000 1.4e-17 3.4e-18 * IEEE cadd 100000 1.1e-16 2.7e-17 * DEC csub 10000 1.4e-17 4.5e-18 * IEEE csub 100000 1.1e-16 3.4e-17 * DEC cmul 3000 2.3e-17 8.7e-18 * IEEE cmul 100000 2.1e-16 6.9e-17 * DEC cdiv 18000 4.9e-17 1.3e-17 * IEEE cdiv 100000 3.7e-16 1.1e-16 */ /* cmplx.c * complex number arithmetic */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_cabs ( cmplx * ); extern double sqrt ( double ); extern double md_atan2 ( double, double ); extern double md_cos ( double ); extern double md_sin ( double ); extern double sqrt ( double ); extern double md_frexp ( double, int * ); extern double md_ldexp ( double, int ); int isnan ( double ); void cdiv ( cmplx *, cmplx *, cmplx * ); void cadd ( cmplx *, cmplx *, cmplx * ); #else double md_fabs(), md_cabs(), sqrt(), md_atan2(), md_cos(), md_sin(); double sqrt(), md_frexp(), md_ldexp(); int isnan(); void cdiv(), cadd(); #endif extern double MAXNUM, MACHEP, PI, PIO2, INFINITY, NAN; /* typedef struct { double r; double i; }cmplx; */ cmplx czero = {0.0, 0.0}; extern cmplx czero; cmplx cone = {1.0, 0.0}; extern cmplx cone; /* c = b + a */ void cadd( a, b, c ) register cmplx *a, *b; cmplx *c; { c->r = b->r + a->r; c->i = b->i + a->i; } /* c = b - a */ void csub( a, b, c ) register cmplx *a, *b; cmplx *c; { c->r = b->r - a->r; c->i = b->i - a->i; } /* c = b * a */ void cmul( a, b, c ) register cmplx *a, *b; cmplx *c; { double y; y = b->r * a->r - b->i * a->i; c->i = b->r * a->i + b->i * a->r; c->r = y; } /* c = b / a */ void cdiv( a, b, c ) register cmplx *a, *b; cmplx *c; { double y, p, q, w; y = a->r * a->r + a->i * a->i; p = b->r * a->r + b->i * a->i; q = b->i * a->r - b->r * a->i; if( y < 1.0 ) { w = MAXNUM * y; if( (md_fabs(p) > w) || (md_fabs(q) > w) || (y == 0.0) ) { c->r = MAXNUM; c->i = MAXNUM; mtherr( "cdiv", OVERFLOW ); return; } } c->r = p/y; c->i = q/y; } /* b = a Caution, a `short' is assumed to be 16 bits wide. */ void cmov( a, b ) void *a, *b; { register short *pa, *pb; int i; pa = (short *) a; pb = (short *) b; i = 8; do *pb++ = *pa++; while( --i ); } void cneg( a ) register cmplx *a; { a->r = -a->r; a->i = -a->i; } /* md_cabs() * * Complex absolute value * * * * SYNOPSIS: * * double md_cabs(); * cmplx z; * double a; * * a = md_cabs( &z ); * * * * DESCRIPTION: * * * If z = x + iy * * then * * a = sqrt( x**2 + y**2 ). * * Overflow and underflow are avoided by testing the magnitudes * of x and y before squaring. If either is outside half of * the floating point full scale range, both are rescaled. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -30,+30 30000 3.2e-17 9.2e-18 * IEEE -10,+10 100000 2.7e-16 6.9e-17 */ /* Cephes Math Library Release 2.1: January, 1989 Copyright 1984, 1987, 1989 by Stephen L. Moshier Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */ /* typedef struct { double r; double i; }cmplx; */ #ifdef UNK #define PREC 27 #define MAXEXP 1024 #define MINEXP -1077 #endif #ifdef DEC #define PREC 29 #define MAXEXP 128 #define MINEXP -128 #endif #ifdef IBMPC #define PREC 27 #define MAXEXP 1024 #define MINEXP -1077 #endif #ifdef MIEEE #define PREC 27 #define MAXEXP 1024 #define MINEXP -1077 #endif double md_cabs( z ) register cmplx *z; { double x, y, b, re, im; int ex, ey, e; #ifdef INFINITIES /* Note, md_cabs(INFINITY,NAN) = INFINITY. */ if( z->r == INFINITY || z->i == INFINITY || z->r == -INFINITY || z->i == -INFINITY ) return( INFINITY ); #endif #ifdef NANS if( isnan(z->r) ) return(z->r); if( isnan(z->i) ) return(z->i); #endif re = md_fabs( z->r ); im = md_fabs( z->i ); if( re == 0.0 ) return( im ); if( im == 0.0 ) return( re ); /* Get the exponents of the numbers */ x = md_frexp( re, &ex ); y = md_frexp( im, &ey ); /* Check if one number is tiny compared to the other */ e = ex - ey; if( e > PREC ) return( re ); if( e < -PREC ) return( im ); /* Find approximate exponent e of the geometric mean. */ e = (ex + ey) >> 1; /* Rescale so mean is about 1 */ x = md_ldexp( re, -e ); y = md_ldexp( im, -e ); /* Hypotenuse of the right triangle */ b = sqrt( x * x + y * y ); /* Compute the exponent of the answer. */ y = md_frexp( b, &ey ); ey = e + ey; /* Check it for overflow and underflow. */ if( ey > MAXEXP ) { mtherr( "md_cabs", OVERFLOW ); return( INFINITY ); } if( ey < MINEXP ) return(0.0); /* Undo the scaling */ b = md_ldexp( b, e ); return( b ); } /* md_csqrt() * * Complex square root * * * * SYNOPSIS: * * void md_csqrt(); * cmplx z, w; * * md_csqrt( &z, &w ); * * * * DESCRIPTION: * * * If z = x + iy, r = |z|, then * * 1/2 * Im w = [ (r - x)/2 ] , * * Re w = y / 2 Im w. * * * Note that -w is also a square root of z. The root chosen * is always in the upper half plane. * * Because of the potential for cancellation error in r - x, * the result is sharpened by doing a Heron iteration * (see sqrt.c) in complex arithmetic. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 25000 3.2e-17 9.6e-18 * IEEE -10,+10 100000 3.2e-16 7.7e-17 * * 2 * Also tested by md_csqrt( z ) = z, and tested by arguments * close to the real axis. */ void md_csqrt( z, w ) cmplx *z, *w; { cmplx q, s; double x, y, r, t; x = z->r; y = z->i; if( y == 0.0 ) { if( x < 0.0 ) { w->r = 0.0; w->i = sqrt(-x); return; } else { w->r = sqrt(x); w->i = 0.0; return; } } if( x == 0.0 ) { r = md_fabs(y); r = sqrt(0.5*r); if( y > 0 ) w->r = r; else w->r = -r; w->i = r; return; } /* Approximate sqrt(x^2+y^2) - x = y^2/2x - y^4/24x^3 + ... . * The relative error in the first term is approximately y^2/12x^2 . */ if( (md_fabs(y) < 2.e-4 * md_fabs(x)) && (x > 0) ) { t = 0.25*y*(y/x); } else { r = md_cabs(z); t = 0.5*(r - x); } r = sqrt(t); q.i = r; q.r = y/(2.0*r); /* Heron iteration in complex arithmetic */ cdiv( &q, z, &s ); cadd( &q, &s, w ); w->r *= 0.5; w->i *= 0.5; } double md_hypot( x, y ) double x, y; { cmplx z; z.r = x; z.i = y; return( md_cabs(&z) ); } Math-Cephes-0.5306/libmd/polylog.c0000644000175000017500000002440714757021403016523 0ustar shlomifshlomif/* polylog.c * * Polylogarithms * * * * SYNOPSIS: * * double x, y, polylog(); * int n; * * y = polylog( n, x ); * * * The polylogarithm of order n is defined by the series * * * inf k * - x * Li (x) = > --- . * n - n * k=1 k * * * For x = 1, * * inf * - 1 * Li (1) = > --- = Riemann zeta function (n) . * n - n * k=1 k * * * When n = 2, the function is the dilogarithm, related to Spence's integral: * * x 1-x * - - * | | -ln(1-t) | | ln t * Li (x) = | -------- dt = | ------ dt = spence(1-x) . * 2 | | t | | 1 - t * - - * 0 1 * * * See also the program cpolylog.c for the complex polylogarithm, * whose definition is extended to x > 1. * * References: * * Lewin, L., _Polylogarithms and Associated Functions_, * North Holland, 1981. * * Lewin, L., ed., _Structural Properties of Polylogarithms_, * American Mathematical Society, 1991. * * * ACCURACY: * * Relative error: * arithmetic domain n # trials peak rms * IEEE 0, 1 2 50000 6.2e-16 8.0e-17 * IEEE 0, 1 3 100000 2.5e-16 6.6e-17 * IEEE 0, 1 4 30000 1.7e-16 4.9e-17 * IEEE 0, 1 5 30000 5.1e-16 7.8e-17 * */ /* Cephes Math Library Release 2.8: July, 1999 Copyright 1999 by Stephen L. Moshier */ #include "mconf.h" extern double PI; /* polylog(4, 1-x) = zeta(4) - x zeta(3) + x^2 A4(x)/B4(x) 0 <= x <= 0.125 Theoretical peak absolute error 4.5e-18 */ #if UNK static double A4[13] = { 3.056144922089490701751E-2, 3.243086484162581557457E-1, 2.877847281461875922565E-1, 7.091267785886180663385E-2, 6.466460072456621248630E-3, 2.450233019296542883275E-4, 4.031655364627704957049E-6, 2.884169163909467997099E-8, 8.680067002466594858347E-11, 1.025983405866370985438E-13, 4.233468313538272640380E-17, 4.959422035066206902317E-21, 1.059365867585275714599E-25, }; static double B4[12] = { /* 1.000000000000000000000E0, */ 2.821262403600310974875E0, 1.780221124881327022033E0, 3.778888211867875721773E-1, 3.193887040074337940323E-2, 1.161252418498096498304E-3, 1.867362374829870620091E-5, 1.319022779715294371091E-7, 3.942755256555603046095E-10, 4.644326968986396928092E-13, 1.913336021014307074861E-16, 2.240041814626069927477E-20, 4.784036597230791011855E-25, }; #endif #if DEC static short A4[52] = { 0036772,0056001,0016601,0164507, 0037646,0005710,0076603,0176456, 0037623,0054205,0013532,0026476, 0037221,0035252,0101064,0065407, 0036323,0162231,0042033,0107244, 0035200,0073170,0106141,0136543, 0033607,0043647,0163672,0055340, 0031767,0137614,0173376,0072313, 0027676,0160156,0161276,0034203, 0025347,0003752,0123106,0064266, 0022503,0035770,0160173,0177501, 0017273,0056226,0033704,0132530, 0013403,0022244,0175205,0052161, }; static short B4[48] = { /*0040200,0000000,0000000,0000000, */ 0040464,0107620,0027471,0071672, 0040343,0157111,0025601,0137255, 0037701,0075244,0140412,0160220, 0037002,0151125,0036572,0057163, 0035630,0032452,0050727,0161653, 0034234,0122515,0034323,0172615, 0032415,0120405,0123660,0003160, 0030330,0140530,0161045,0150177, 0026002,0134747,0014542,0002510, 0023134,0113666,0035730,0035732, 0017723,0110343,0041217,0007764, 0014024,0007412,0175575,0160230, }; #endif #if IBMPC static short A4[52] = { 0x3d29,0x23b0,0x4b80,0x3f9f, 0x7fa6,0x0fb0,0xc179,0x3fd4, 0x45a8,0xa2eb,0x6b10,0x3fd2, 0x8d61,0x5046,0x2755,0x3fb2, 0x71d4,0x2883,0x7c93,0x3f7a, 0x37ac,0x118c,0x0ecf,0x3f30, 0x4b5c,0xfcf7,0xe8f4,0x3ed0, 0xce99,0x9edf,0xf7f1,0x3e5e, 0xc710,0xdc57,0xdc0d,0x3dd7, 0xcd17,0x54c8,0xe0fd,0x3d3c, 0x7fe8,0x1c0f,0x677f,0x3c88, 0x96ab,0xc6f8,0x6b92,0x3bb7, 0xaa8e,0x9f50,0x6494,0x3ac0, }; static short B4[48] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x2e77,0x05e7,0x91f2,0x4006, 0x37d6,0x2570,0x7bc9,0x3ffc, 0x5c12,0x9821,0x2f54,0x3fd8, 0x4bce,0xa7af,0x5a4a,0x3fa0, 0xfc75,0x4a3a,0x06a5,0x3f53, 0x7eb2,0xa71a,0x94a9,0x3ef3, 0x00ce,0xb4f6,0xb420,0x3e81, 0xba10,0x1c44,0x182b,0x3dfb, 0x40a9,0xe32c,0x573c,0x3d60, 0x077b,0xc77b,0x92f6,0x3cab, 0xe1fe,0x6851,0x721c,0x3bda, 0xbc13,0x5f6f,0x81e1,0x3ae2, }; #endif #if MIEEE static short A4[52] = { 0x3f9f,0x4b80,0x23b0,0x3d29, 0x3fd4,0xc179,0x0fb0,0x7fa6, 0x3fd2,0x6b10,0xa2eb,0x45a8, 0x3fb2,0x2755,0x5046,0x8d61, 0x3f7a,0x7c93,0x2883,0x71d4, 0x3f30,0x0ecf,0x118c,0x37ac, 0x3ed0,0xe8f4,0xfcf7,0x4b5c, 0x3e5e,0xf7f1,0x9edf,0xce99, 0x3dd7,0xdc0d,0xdc57,0xc710, 0x3d3c,0xe0fd,0x54c8,0xcd17, 0x3c88,0x677f,0x1c0f,0x7fe8, 0x3bb7,0x6b92,0xc6f8,0x96ab, 0x3ac0,0x6494,0x9f50,0xaa8e, }; static short B4[48] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4006,0x91f2,0x05e7,0x2e77, 0x3ffc,0x7bc9,0x2570,0x37d6, 0x3fd8,0x2f54,0x9821,0x5c12, 0x3fa0,0x5a4a,0xa7af,0x4bce, 0x3f53,0x06a5,0x4a3a,0xfc75, 0x3ef3,0x94a9,0xa71a,0x7eb2, 0x3e81,0xb420,0xb4f6,0x00ce, 0x3dfb,0x182b,0x1c44,0xba10, 0x3d60,0x573c,0xe32c,0x40a9, 0x3cab,0x92f6,0xc77b,0x077b, 0x3bda,0x721c,0x6851,0xe1fe, 0x3ae2,0x81e1,0x5f6f,0xbc13, }; #endif #ifdef ANSIPROT extern double spence ( double ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double zetac ( double ); extern double md_pow ( double, double ); extern double md_powi ( double, int ); extern double md_log ( double ); extern double fac ( int i ); extern double md_fabs (double); double polylog (int, double); #else extern double spence(), polevl(), p1evl(), zetac(); extern double md_pow(), md_powi(), md_log(); extern double fac(); /* factorial */ extern double md_fabs(); double polylog(); #endif extern double MACHEP; double polylog (n, x) int n; double x; { double h, k, p, s, t, u, xc, z; int i, j; /* This recurrence provides formulas for n < 2. d 1 -- Li (x) = --- Li (x) . dx n x n-1 */ if (n == -1) { p = 1.0 - x; u = x / p; s = u * u + u; return s; } if (n == 0) { s = x / (1.0 - x); return s; } /* Not implemented for n < -1. Not defined for x > 1. Use cpolylog if you need that. */ if (x > 1.0 || n < -1) { mtherr("polylog", DOMAIN); return 0.0; } if (n == 1) { s = -md_log (1.0 - x); return s; } /* Argument +1 */ if (x == 1.0 && n > 1) { s = zetac ((double) n) + 1.0; return s; } /* Argument -1. 1-n Li (-z) = - (1 - 2 ) Li (z) n n */ if (x == -1.0 && n > 1) { /* Li_n(1) = zeta(n) */ s = zetac ((double) n) + 1.0; s = s * (md_powi (2.0, 1 - n) - 1.0); return s; } /* Inversion formula: * [n/2] n-2r * n 1 n - md_log (z) * Li (-z) + (-1) Li (-1/z) = - --- md_log (z) + 2 > ----------- Li (-1) * n n n! - (n - 2r)! 2r * r=1 */ if (x < -1.0 && n > 1) { double q, w; int r; w = md_log (-x); s = 0.0; for (r = 1; r <= n / 2; r++) { j = 2 * r; p = polylog (j, -1.0); j = n - j; if (j == 0) { s = s + p; break; } q = (double) j; q = md_pow (w, q) * p / fac (j); s = s + q; } s = 2.0 * s; q = polylog (n, 1.0 / x); if (n & 1) q = -q; s = s - q; s = s - md_pow (w, (double) n) / fac (n); return s; } if (n == 2) { if (x < 0.0 || x > 1.0) return (spence (1.0 - x)); } /* The power series converges slowly when x is near 1. For n = 3, this identity helps: Li (-x/(1-x)) + Li (1-x) + Li (x) 3 3 3 2 2 3 = Li (1) + (pi /6) md_log(1-x) - (1/2) md_log(x) md_log (1-x) + (1/6) md_log (1-x) 3 */ if (n == 3) { p = x * x * x; if (x > 0.8) { u = md_log(x); s = u * u * u / 6.0; xc = 1.0 - x; s = s - 0.5 * u * u * md_log(xc); s = s + PI * PI * u / 6.0; s = s - polylog (3, -xc/x); s = s - polylog (3, xc); s = s + zetac(3.0); s = s + 1.0; return s; } /* Power series */ t = p / 27.0; t = t + .125 * x * x; t = t + x; s = 0.0; k = 4.0; do { p = p * x; h = p / (k * k * k); s = s + h; k += 1.0; } while (md_fabs(h/s) > 1.1e-16); return (s + t); } if (n == 4) { if (x >= 0.875) { u = 1.0 - x; s = polevl(u, A4, 12) / p1evl(u, B4, 12); s = s * u * u - 1.202056903159594285400 * u; s += 1.0823232337111381915160; return s; } goto pseries; } if (x < 0.75) goto pseries; /* This expansion in powers of md_log(x) is especially useful when x is near 1. See also the pari gp calculator. inf j - z(n-j) (md_log(x)) polylog(n,x) = > ----------------- - j! j=0 where z(j) = Riemann zeta function (j), j != 1 n-1 - z(1) = -md_log(-md_log(x)) + > 1/k - k=1 */ z = md_log(x); h = -md_log(-z); for (i = 1; i < n; i++) h = h + 1.0/i; p = 1.0; s = zetac((double)n) + 1.0; for (j=1; j<=n+1; j++) { p = p * z / j; if (j == n-1) s = s + h * p; else s = s + (zetac((double)(n-j)) + 1.0) * p; } j = n + 3; z = z * z; for(;;) { p = p * z / ((j-1)*j); h = (zetac((double)(n-j)) + 1.0); h = h * p; s = s + h; if (md_fabs(h/s) < MACHEP) break; j += 2; } return s; pseries: p = x * x * x; k = 3.0; s = 0.0; do { p = p * x; k += 1.0; h = p / md_powi(k, n); s = s + h; } while (md_fabs(h/s) > MACHEP); s += x * x * x / md_powi(3.0,n); s += x * x / md_powi(2.0,n); s += x; return s; } Math-Cephes-0.5306/libmd/j1.c0000644000175000017500000002754314757021403015354 0ustar shlomifshlomif/* md_j1.c * * Bessel function of order one * * * * SYNOPSIS: * * double x, y, md_j1(); * * y = md_j1( x ); * * * * DESCRIPTION: * * Returns Bessel function of order one of the argument. * * The domain is divided into the intervals [0, 8] and * (8, infinity). In the first interval a 24 term Chebyshev * expansion is used. In the second, the asymptotic * trigonometric representation is employed using two * rational functions of degree 5/5. * * * * ACCURACY: * * Absolute error: * arithmetic domain # trials peak rms * DEC 0, 30 10000 4.0e-17 1.1e-17 * IEEE 0, 30 30000 2.6e-16 1.1e-16 * * */ /* md_y1.c * * Bessel function of second kind of order one * * * * SYNOPSIS: * * double x, y, md_y1(); * * y = md_y1( x ); * * * * DESCRIPTION: * * Returns Bessel function of the second kind of order one * of the argument. * * The domain is divided into the intervals [0, 8] and * (8, infinity). In the first interval a 25 term Chebyshev * expansion is used, and a call to md_j1() is required. * In the second, the asymptotic trigonometric representation * is employed using two rational functions of degree 5/5. * * * * ACCURACY: * * Absolute error: * arithmetic domain # trials peak rms * DEC 0, 30 10000 8.6e-17 1.3e-17 * IEEE 0, 30 30000 1.0e-15 1.3e-16 * * (error criterion relative when |md_y1| > 1). * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier */ /* #define PIO4 .78539816339744830962 #define THPIO4 2.35619449019234492885 #define SQ2OPI .79788456080286535588 */ #include "mconf.h" #ifdef UNK static double RP[4] = { -8.99971225705559398224E8, 4.52228297998194034323E11, -7.27494245221818276015E13, 3.68295732863852883286E15, }; static double RQ[8] = { /* 1.00000000000000000000E0,*/ 6.20836478118054335476E2, 2.56987256757748830383E5, 8.35146791431949253037E7, 2.21511595479792499675E10, 4.74914122079991414898E12, 7.84369607876235854894E14, 8.95222336184627338078E16, 5.32278620332680085395E18, }; #endif #ifdef DEC static unsigned short RP[16] = { 0147526,0110742,0063322,0077052, 0051722,0112720,0065034,0061530, 0153604,0052227,0033147,0105650, 0055121,0055025,0032276,0022015, }; static unsigned short RQ[32] = { /*0040200,0000000,0000000,0000000,*/ 0042433,0032610,0155604,0033473, 0044572,0173320,0067270,0006616, 0046637,0045246,0162225,0006606, 0050645,0004773,0157577,0053004, 0052612,0033734,0001667,0176501, 0054462,0054121,0173147,0121367, 0056237,0002777,0121451,0176007, 0057623,0136253,0131601,0044710, }; #endif #ifdef IBMPC static unsigned short RP[16] = { 0x4fc5,0x4cda,0xd23c,0xc1ca, 0x8c6b,0x0d43,0x52ba,0x425a, 0xf175,0xe6cc,0x8a92,0xc2d0, 0xc482,0xa697,0x2b42,0x432a, }; static unsigned short RQ[32] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x86e7,0x1b70,0x66b1,0x4083, 0x01b2,0x0dd7,0x5eda,0x410f, 0xa1b1,0xdc92,0xe954,0x4193, 0xeac1,0x7bef,0xa13f,0x4214, 0xffa8,0x8076,0x46fb,0x4291, 0xf45f,0x3ecc,0x4b0a,0x4306, 0x3f81,0xf465,0xe0bf,0x4373, 0x2939,0x7670,0x7795,0x43d2, }; #endif #ifdef MIEEE static unsigned short RP[16] = { 0xc1ca,0xd23c,0x4cda,0x4fc5, 0x425a,0x52ba,0x0d43,0x8c6b, 0xc2d0,0x8a92,0xe6cc,0xf175, 0x432a,0x2b42,0xa697,0xc482, }; static unsigned short RQ[32] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4083,0x66b1,0x1b70,0x86e7, 0x410f,0x5eda,0x0dd7,0x01b2, 0x4193,0xe954,0xdc92,0xa1b1, 0x4214,0xa13f,0x7bef,0xeac1, 0x4291,0x46fb,0x8076,0xffa8, 0x4306,0x4b0a,0x3ecc,0xf45f, 0x4373,0xe0bf,0xf465,0x3f81, 0x43d2,0x7795,0x7670,0x2939, }; #endif #ifdef UNK static double PP[7] = { 7.62125616208173112003E-4, 7.31397056940917570436E-2, 1.12719608129684925192E0, 5.11207951146807644818E0, 8.42404590141772420927E0, 5.21451598682361504063E0, 1.00000000000000000254E0, }; static double PQ[7] = { 5.71323128072548699714E-4, 6.88455908754495404082E-2, 1.10514232634061696926E0, 5.07386386128601488557E0, 8.39985554327604159757E0, 5.20982848682361821619E0, 9.99999999999999997461E-1, }; #endif #ifdef DEC static unsigned short PP[28] = { 0035507,0144542,0061543,0024326, 0037225,0145105,0017766,0022661, 0040220,0043766,0010254,0133255, 0040643,0113047,0142611,0151521, 0041006,0144344,0055351,0074261, 0040646,0156520,0120574,0006416, 0040200,0000000,0000000,0000000, }; static unsigned short PQ[28] = { 0035425,0142330,0115041,0165514, 0037214,0177352,0145105,0052026, 0040215,0072515,0141207,0073255, 0040642,0056427,0137222,0106405, 0041006,0062716,0166427,0165450, 0040646,0133352,0035425,0123304, 0040200,0000000,0000000,0000000, }; #endif #ifdef IBMPC static unsigned short PP[28] = { 0x651b,0x4c6c,0xf92c,0x3f48, 0xc4b6,0xa3fe,0xb948,0x3fb2, 0x96d6,0xc215,0x08fe,0x3ff2, 0x3a6a,0xf8b1,0x72c4,0x4014, 0x2f16,0x8b5d,0xd91c,0x4020, 0x81a2,0x142f,0xdbaa,0x4014, 0x0000,0x0000,0x0000,0x3ff0, }; static unsigned short PQ[28] = { 0x3d69,0x1344,0xb89b,0x3f42, 0xaa83,0x5948,0x9fdd,0x3fb1, 0xeed6,0xb850,0xaea9,0x3ff1, 0x51a1,0xf7d2,0x4ba2,0x4014, 0xfd65,0xdda2,0xccb9,0x4020, 0xb4d9,0x4762,0xd6dd,0x4014, 0x0000,0x0000,0x0000,0x3ff0, }; #endif #ifdef MIEEE static unsigned short PP[28] = { 0x3f48,0xf92c,0x4c6c,0x651b, 0x3fb2,0xb948,0xa3fe,0xc4b6, 0x3ff2,0x08fe,0xc215,0x96d6, 0x4014,0x72c4,0xf8b1,0x3a6a, 0x4020,0xd91c,0x8b5d,0x2f16, 0x4014,0xdbaa,0x142f,0x81a2, 0x3ff0,0x0000,0x0000,0x0000, }; static unsigned short PQ[28] = { 0x3f42,0xb89b,0x1344,0x3d69, 0x3fb1,0x9fdd,0x5948,0xaa83, 0x3ff1,0xaea9,0xb850,0xeed6, 0x4014,0x4ba2,0xf7d2,0x51a1, 0x4020,0xccb9,0xdda2,0xfd65, 0x4014,0xd6dd,0x4762,0xb4d9, 0x3ff0,0x0000,0x0000,0x0000, }; #endif #ifdef UNK static double QP[8] = { 5.10862594750176621635E-2, 4.98213872951233449420E0, 7.58238284132545283818E1, 3.66779609360150777800E2, 7.10856304998926107277E2, 5.97489612400613639965E2, 2.11688757100572135698E2, 2.52070205858023719784E1, }; static double QQ[7] = { /* 1.00000000000000000000E0,*/ 7.42373277035675149943E1, 1.05644886038262816351E3, 4.98641058337653607651E3, 9.56231892404756170795E3, 7.99704160447350683650E3, 2.82619278517639096600E3, 3.36093607810698293419E2, }; #endif #ifdef DEC static unsigned short QP[32] = { 0037121,0037723,0055605,0151004, 0040637,0066656,0031554,0077264, 0041627,0122714,0153170,0161466, 0042267,0061712,0036520,0140145, 0042461,0133315,0131573,0071176, 0042425,0057525,0147500,0013201, 0042123,0130122,0061245,0154131, 0041311,0123772,0064254,0172650, }; static unsigned short QQ[28] = { /*0040200,0000000,0000000,0000000,*/ 0041624,0074603,0002112,0101670, 0042604,0007135,0010162,0175565, 0043233,0151510,0157757,0172010, 0043425,0064506,0112006,0104276, 0043371,0164125,0032271,0164242, 0043060,0121425,0122750,0136013, 0042250,0005773,0053472,0146267, }; #endif #ifdef IBMPC static unsigned short QP[32] = { 0xba40,0x6b70,0x27fa,0x3faa, 0x8fd6,0xc66d,0xedb5,0x4013, 0x1c67,0x9acf,0xf4b9,0x4052, 0x180d,0x47aa,0xec79,0x4076, 0x6e50,0xb66f,0x36d9,0x4086, 0x02d0,0xb9e8,0xabea,0x4082, 0xbb0b,0x4c54,0x760a,0x406a, 0x9eb5,0x4d15,0x34ff,0x4039, }; static unsigned short QQ[28] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x5077,0x6089,0x8f30,0x4052, 0x5f6f,0xa20e,0x81cb,0x4090, 0xfe81,0x1bfd,0x7a69,0x40b3, 0xd118,0xd280,0xad28,0x40c2, 0x3d14,0xa697,0x3d0a,0x40bf, 0x1781,0xb4bd,0x1462,0x40a6, 0x5997,0x6ae7,0x017f,0x4075, }; #endif #ifdef MIEEE static unsigned short QP[32] = { 0x3faa,0x27fa,0x6b70,0xba40, 0x4013,0xedb5,0xc66d,0x8fd6, 0x4052,0xf4b9,0x9acf,0x1c67, 0x4076,0xec79,0x47aa,0x180d, 0x4086,0x36d9,0xb66f,0x6e50, 0x4082,0xabea,0xb9e8,0x02d0, 0x406a,0x760a,0x4c54,0xbb0b, 0x4039,0x34ff,0x4d15,0x9eb5, }; static unsigned short QQ[28] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4052,0x8f30,0x6089,0x5077, 0x4090,0x81cb,0xa20e,0x5f6f, 0x40b3,0x7a69,0x1bfd,0xfe81, 0x40c2,0xad28,0xd280,0xd118, 0x40bf,0x3d0a,0xa697,0x3d14, 0x40a6,0x1462,0xb4bd,0x1781, 0x4075,0x017f,0x6ae7,0x5997, }; #endif #ifdef UNK static double YP[6] = { 1.26320474790178026440E9, -6.47355876379160291031E11, 1.14509511541823727583E14, -8.12770255501325109621E15, 2.02439475713594898196E17, -7.78877196265950026825E17, }; static double YQ[8] = { /* 1.00000000000000000000E0,*/ 5.94301592346128195359E2, 2.35564092943068577943E5, 7.34811944459721705660E7, 1.87601316108706159478E10, 3.88231277496238566008E12, 6.20557727146953693363E14, 6.87141087355300489866E16, 3.97270608116560655612E18, }; #endif #ifdef DEC static unsigned short YP[24] = { 0047626,0112763,0013715,0133045, 0152026,0134552,0142033,0024411, 0053720,0045245,0102210,0077565, 0155347,0000321,0136415,0102031, 0056463,0146550,0055633,0032605, 0157054,0171012,0167361,0054265, }; static unsigned short YQ[32] = { /*0040200,0000000,0000000,0000000,*/ 0042424,0111515,0044773,0153014, 0044546,0005405,0171307,0075774, 0046614,0023575,0047105,0063556, 0050613,0143034,0101533,0156026, 0052541,0175367,0166514,0114257, 0054415,0014466,0134350,0171154, 0056164,0017436,0025075,0022101, 0057534,0103614,0103663,0121772, }; #endif #ifdef IBMPC static unsigned short YP[24] = { 0xb6c5,0x62f9,0xd2be,0x41d2, 0x6521,0x5883,0xd72d,0xc262, 0x0fef,0xb091,0x0954,0x42da, 0xb083,0x37a1,0xe01a,0xc33c, 0x66b1,0x0b73,0x79ad,0x4386, 0x2b17,0x5dde,0x9e41,0xc3a5, }; static unsigned short YQ[32] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x7ac2,0xa93f,0x9269,0x4082, 0xef7f,0xbe58,0xc160,0x410c, 0xacee,0xa9c8,0x84ef,0x4191, 0x7b83,0x906b,0x78c3,0x4211, 0x9316,0xfda9,0x3f5e,0x428c, 0x1e4e,0xd71d,0xa326,0x4301, 0xa488,0xc547,0x83e3,0x436e, 0x747f,0x90f6,0x90f1,0x43cb, }; #endif #ifdef MIEEE static unsigned short YP[24] = { 0x41d2,0xd2be,0x62f9,0xb6c5, 0xc262,0xd72d,0x5883,0x6521, 0x42da,0x0954,0xb091,0x0fef, 0xc33c,0xe01a,0x37a1,0xb083, 0x4386,0x79ad,0x0b73,0x66b1, 0xc3a5,0x9e41,0x5dde,0x2b17, }; static unsigned short YQ[32] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4082,0x9269,0xa93f,0x7ac2, 0x410c,0xc160,0xbe58,0xef7f, 0x4191,0x84ef,0xa9c8,0xacee, 0x4211,0x78c3,0x906b,0x7b83, 0x428c,0x3f5e,0xfda9,0x9316, 0x4301,0xa326,0xd71d,0x1e4e, 0x436e,0x83e3,0xc547,0xa488, 0x43cb,0x90f1,0x90f6,0x747f, }; #endif #ifdef UNK static double Z1 = 1.46819706421238932572E1; static double Z2 = 4.92184563216946036703E1; #endif #ifdef DEC static unsigned short DZ1[] = {0041152,0164532,0006114,0010540}; static unsigned short DZ2[] = {0041504,0157663,0001625,0020621}; #define Z1 (*(double *)DZ1) #define Z2 (*(double *)DZ2) #endif #ifdef IBMPC static unsigned short DZ1[] = {0x822c,0x4189,0x5d2b,0x402d}; static unsigned short DZ2[] = {0xa432,0x6072,0x9bf6,0x4048}; #define Z1 (*(double *)DZ1) #define Z2 (*(double *)DZ2) #endif #ifdef MIEEE static unsigned short DZ1[] = {0x402d,0x5d2b,0x4189,0x822c}; static unsigned short DZ2[] = {0x4048,0x9bf6,0x6072,0xa432}; #define Z1 (*(double *)DZ1) #define Z2 (*(double *)DZ2) #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_log ( double ); extern double md_sin ( double ); extern double md_cos ( double ); extern double sqrt ( double ); double md_j1 ( double ); #else double polevl(), p1evl(), md_log(), md_sin(), md_cos(), sqrt(); double md_j1(); #endif extern double TWOOPI, THPIO4, SQ2OPI; double md_j1(x) double x; { double w, z, p, q, xn; w = x; if( x < 0 ) w = -x; if( w <= 5.0 ) { z = x * x; w = polevl( z, RP, 3 ) / p1evl( z, RQ, 8 ); w = w * x * (z - Z1) * (z - Z2); return( w ); } w = 5.0/x; z = w * w; p = polevl( z, PP, 6)/polevl( z, PQ, 6 ); q = polevl( z, QP, 7)/p1evl( z, QQ, 7 ); xn = x - THPIO4; p = p * md_cos(xn) - w * q * md_sin(xn); return( p * SQ2OPI / sqrt(x) ); } extern double MAXNUM; double md_y1(x) double x; { double w, z, p, q, xn; if( x <= 5.0 ) { if( x <= 0.0 ) { mtherr( "md_y1", DOMAIN ); return( -MAXNUM ); } z = x * x; w = x * (polevl( z, YP, 5 ) / p1evl( z, YQ, 8 )); w += TWOOPI * ( md_j1(x) * md_log(x) - 1.0/x ); return( w ); } w = 5.0/x; z = w * w; p = polevl( z, PP, 6)/polevl( z, PQ, 6 ); q = polevl( z, QP, 7)/p1evl( z, QQ, 7 ); xn = x - THPIO4; p = p * md_sin(xn) + w * q * md_cos(xn); return( p * SQ2OPI / sqrt(x) ); } Math-Cephes-0.5306/libmd/log2.c0000644000175000017500000001607114757021403015677 0ustar shlomifshlomif/* md_log2.c * * Base 2 logarithm * * * * SYNOPSIS: * * double x, y, md_log2(); * * y = md_log2( x ); * * * * DESCRIPTION: * * Returns the base 2 logarithm of x. * * The argument is separated into its exponent and fractional * parts. If the exponent is between -1 and +1, the base e * logarithm of the fraction is approximated by * * md_log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). * * Otherwise, setting z = 2(x-1)/x+1), * * md_log(x) = z + z**3 P(z)/Q(z). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0.5, 2.0 30000 2.0e-16 5.5e-17 * IEEE md_exp(+-700) 40000 1.3e-16 4.6e-17 * * In the tests over the interval [md_exp(+-700)], the logarithms * of the random arguments were uniformly distributed. * * ERROR MESSAGES: * * md_log2 singularity: x = 0; returns -INFINITY * md_log2 domain: x < 0; returns NAN */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" static char fname[] = {"md_log2"}; /* Coefficients for md_log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) * 1/sqrt(2) <= x < sqrt(2) */ #ifdef UNK static double P[] = { 1.01875663804580931796E-4, 4.97494994976747001425E-1, 4.70579119878881725854E0, 1.44989225341610930846E1, 1.79368678507819816313E1, 7.70838733755885391666E0, }; static double Q[] = { /* 1.00000000000000000000E0, */ 1.12873587189167450590E1, 4.52279145837532221105E1, 8.29875266912776603211E1, 7.11544750618563894466E1, 2.31251620126765340583E1, }; #define LOG2EA 0.44269504088896340735992 #endif #ifdef DEC static unsigned short P[] = { 0037777,0127270,0162547,0057274, 0041001,0054665,0164317,0005341, 0041451,0034104,0031640,0105773, 0041677,0011276,0123617,0160135, 0041701,0126603,0053215,0117250, 0041420,0115777,0135206,0030232, }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0041220,0144332,0045272,0174241, 0041742,0164566,0035720,0130431, 0042246,0126327,0166065,0116357, 0042372,0033420,0157525,0124560, 0042271,0167002,0066537,0172303, 0041730,0164777,0113711,0044407, }; static unsigned short L[5] = {0037742,0124354,0122560,0057703}; #define LOG2EA (*(double *)(&L[0])) #endif #ifdef IBMPC static unsigned short P[] = { 0x1bb0,0x93c3,0xb4c2,0x3f1a, 0x52f2,0x3f56,0xd6f5,0x3fdf, 0x6911,0xed92,0xd2ba,0x4012, 0xeb2e,0xc63e,0xff72,0x402c, 0xc84d,0x924b,0xefd6,0x4031, 0xdcf8,0x7d7e,0xd563,0x401e, }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xef8e,0xae97,0x9320,0x4026, 0xc033,0x4e19,0x9d2c,0x4046, 0xbdbd,0xa326,0xbf33,0x4054, 0xae21,0xeb5e,0xc9e2,0x4051, 0x25b2,0x9e1f,0x200a,0x4037, }; static unsigned short L[5] = {0x0bf8,0x94ae,0x551d,0x3fdc}; #define LOG2EA (*(double *)(&L[0])) #endif #ifdef MIEEE static unsigned short P[] = { 0x3f1a,0xb4c2,0x93c3,0x1bb0, 0x3fdf,0xd6f5,0x3f56,0x52f2, 0x4012,0xd2ba,0xed92,0x6911, 0x402c,0xff72,0xc63e,0xeb2e, 0x4031,0xefd6,0x924b,0xc84d, 0x401e,0xd563,0x7d7e,0xdcf8, }; static unsigned short Q[] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4026,0x9320,0xae97,0xef8e, 0x4046,0x9d2c,0x4e19,0xc033, 0x4054,0xbf33,0xa326,0xbdbd, 0x4051,0xc9e2,0xeb5e,0xae21, 0x4037,0x200a,0x9e1f,0x25b2, }; static unsigned short L[5] = {0x3fdc,0x551d,0x94ae,0x0bf8}; #define LOG2EA (*(double *)(&L[0])) #endif /* Coefficients for md_log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/(x+1) * 1/sqrt(2) <= x < sqrt(2) */ #ifdef UNK static double R[3] = { -7.89580278884799154124E-1, 1.63866645699558079767E1, -6.41409952958715622951E1, }; static double S[3] = { /* 1.00000000000000000000E0,*/ -3.56722798256324312549E1, 3.12093766372244180303E2, -7.69691943550460008604E2, }; /* md_log2(e) - 1 */ #define LOG2EA 0.44269504088896340735992 #endif #ifdef DEC static unsigned short R[12] = { 0140112,0020756,0161540,0072035, 0041203,0013743,0114023,0155527, 0141600,0044060,0104421,0050400, }; static unsigned short S[12] = { /*0040200,0000000,0000000,0000000,*/ 0141416,0130152,0017543,0064122, 0042234,0006000,0104527,0020155, 0142500,0066110,0146631,0174731, }; /* md_log2(e) - 1 */ #define LOG2EA 0.44269504088896340735992L #endif #ifdef IBMPC static unsigned short R[12] = { 0x0e84,0xdc6c,0x443d,0xbfe9, 0x7b6b,0x7302,0x62fc,0x4030, 0x2a20,0x1122,0x0906,0xc050, }; static unsigned short S[12] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x6d0a,0x43ec,0xd60d,0xc041, 0xe40e,0x112a,0x8180,0x4073, 0x3f3b,0x19b3,0x0d89,0xc088, }; #endif #ifdef MIEEE static unsigned short R[12] = { 0xbfe9,0x443d,0xdc6c,0x0e84, 0x4030,0x62fc,0x7302,0x7b6b, 0xc050,0x0906,0x1122,0x2a20, }; static unsigned short S[12] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0xc041,0xd60d,0x43ec,0x6d0a, 0x4073,0x8180,0x112a,0xe40e, 0xc088,0x0d89,0x19b3,0x3f3b, }; #endif #ifdef ANSIPROT extern double md_frexp ( double, int * ); extern double md_ldexp ( double, int ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern int isnan ( double ); extern int isfinite ( double ); #else double md_frexp(), md_ldexp(), polevl(), p1evl(); int isnan(), isfinite(); #endif #define SQRTH 0.70710678118654752440 extern double LOGE2, INFINITY, NAN; double md_log2(x) double x; { int e; double y; VOLATILE double z; #ifdef DEC short *q; #endif #ifdef NANS if( isnan(x) ) return(x); #endif #ifdef INFINITIES if( x == INFINITY ) return(x); #endif /* Test for domain */ if( x <= 0.0 ) { if( x == 0.0 ) { mtherr( fname, SING ); return( -INFINITY ); } else { mtherr( fname, DOMAIN ); return( NAN ); } } /* separate mantissa from exponent */ #ifdef DEC q = (short *)&x; e = *q; /* short containing exponent */ e = ((e >> 7) & 0377) - 0200; /* the exponent */ *q &= 0177; /* strip exponent from x */ *q |= 040000; /* x now between 0.5 and 1 */ #endif /* Note, md_frexp is used so that denormal numbers * will be handled properly. */ #ifdef IBMPC x = md_frexp( x, &e ); /* q = (short *)&x; q += 3; e = *q; e = ((e >> 4) & 0x0fff) - 0x3fe; *q &= 0x0f; *q |= 0x3fe0; */ #endif /* Equivalent C language standard library function: */ #ifdef UNK x = md_frexp( x, &e ); #endif #ifdef MIEEE x = md_frexp( x, &e ); #endif /* logarithm using md_log(x) = z + z**3 P(z)/Q(z), * where z = 2(x-1)/x+1) */ if( (e > 2) || (e < -2) ) { if( x < SQRTH ) { /* 2( 2x-1 )/( 2x+1 ) */ e -= 1; z = x - 0.5; y = 0.5 * z + 0.5; } else { /* 2 (x-1)/(x+1) */ z = x - 0.5; z -= 0.5; y = 0.5 * x + 0.5; } x = z / y; z = x*x; y = x * ( z * polevl( z, R, 2 ) / p1evl( z, S, 3 ) ); goto ldone; } /* logarithm using md_log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ if( x < SQRTH ) { e -= 1; x = md_ldexp( x, 1 ) - 1.0; /* 2x - 1 */ } else { x = x - 1.0; } z = x*x; #if DEC y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 6 ) ) - md_ldexp( z, -1 ); #else y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 5 ) ) - md_ldexp( z, -1 ); #endif ldone: /* Multiply md_log of fraction by md_log2(e) * and base 2 exponent by 1 * * ***CAUTION*** * * This sequence of operations is critical and it may * be horribly defeated by some compiler optimizers. */ z = y * LOG2EA; z += x * LOG2EA; z += y; z += x; z += e; return( z ); } Math-Cephes-0.5306/libmd/k0.c0000644000175000017500000001633114757021403015345 0ustar shlomifshlomif/* k0.c * * Modified Bessel function, third kind, order zero * * * * SYNOPSIS: * * double x, y, k0(); * * y = k0( x ); * * * * DESCRIPTION: * * Returns modified Bessel function of the third kind * of order zero of the argument. * * The range is partitioned into the two intervals [0,8] and * (8, infinity). Chebyshev polynomial expansions are employed * in each interval. * * * * ACCURACY: * * Tested at 2000 random points between 0 and 8. Peak absolute * error (relative when K0 > 1) was 1.46e-14; rms, 4.26e-15. * Relative error: * arithmetic domain # trials peak rms * DEC 0, 30 3100 1.3e-16 2.1e-17 * IEEE 0, 30 30000 1.2e-15 1.6e-16 * * ERROR MESSAGES: * * message condition value returned * K0 domain x <= 0 MAXNUM * */ /* k0e() * * Modified Bessel function, third kind, order zero, * exponentially scaled * * * * SYNOPSIS: * * double x, y, k0e(); * * y = k0e( x ); * * * * DESCRIPTION: * * Returns exponentially scaled modified Bessel function * of the third kind of order zero of the argument. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0, 30 30000 1.4e-15 1.4e-16 * See k0(). * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" /* Chebyshev coefficients for K0(x) + md_log(x/2) I0(x) * in the interval [0,2]. The odd order coefficients are all * zero; only the even order coefficients are listed. * * lim(x->0){ K0(x) + md_log(x/2) I0(x) } = -EUL. */ #ifdef UNK static double A[] = { 1.37446543561352307156E-16, 4.25981614279661018399E-14, 1.03496952576338420167E-11, 1.90451637722020886025E-9, 2.53479107902614945675E-7, 2.28621210311945178607E-5, 1.26461541144692592338E-3, 3.59799365153615016266E-2, 3.44289899924628486886E-1, -5.35327393233902768720E-1 }; #endif #ifdef DEC static unsigned short A[] = { 0023036,0073417,0032477,0165673, 0025077,0154126,0016046,0012517, 0027066,0011342,0035211,0005041, 0031002,0160233,0037454,0050224, 0032610,0012747,0037712,0173741, 0034277,0144007,0172147,0162375, 0035645,0140563,0125431,0165626, 0037023,0057662,0125124,0102051, 0037660,0043304,0004411,0166707, 0140011,0005467,0047227,0130370 }; #endif #ifdef IBMPC static unsigned short A[] = { 0xfd77,0xe6a7,0xcee1,0x3ca3, 0xc2aa,0xc384,0xfb0a,0x3d27, 0x2144,0x4751,0xc25c,0x3da6, 0x8a13,0x67e5,0x5c13,0x3e20, 0x5efc,0xe7f9,0x02bc,0x3e91, 0xfca0,0xfe8c,0xf900,0x3ef7, 0x3d73,0x7563,0xb82e,0x3f54, 0x9085,0x554a,0x6bf6,0x3fa2, 0x3db9,0x8121,0x08d8,0x3fd6, 0xf61f,0xe9d2,0x2166,0xbfe1 }; #endif #ifdef MIEEE static unsigned short A[] = { 0x3ca3,0xcee1,0xe6a7,0xfd77, 0x3d27,0xfb0a,0xc384,0xc2aa, 0x3da6,0xc25c,0x4751,0x2144, 0x3e20,0x5c13,0x67e5,0x8a13, 0x3e91,0x02bc,0xe7f9,0x5efc, 0x3ef7,0xf900,0xfe8c,0xfca0, 0x3f54,0xb82e,0x7563,0x3d73, 0x3fa2,0x6bf6,0x554a,0x9085, 0x3fd6,0x08d8,0x8121,0x3db9, 0xbfe1,0x2166,0xe9d2,0xf61f }; #endif /* Chebyshev coefficients for md_exp(x) sqrt(x) K0(x) * in the inverted interval [2,infinity]. * * lim(x->inf){ md_exp(x) sqrt(x) K0(x) } = sqrt(pi/2). */ #ifdef UNK static double B[] = { 5.30043377268626276149E-18, -1.64758043015242134646E-17, 5.21039150503902756861E-17, -1.67823109680541210385E-16, 5.51205597852431940784E-16, -1.84859337734377901440E-15, 6.34007647740507060557E-15, -2.22751332699166985548E-14, 8.03289077536357521100E-14, -2.98009692317273043925E-13, 1.14034058820847496303E-12, -4.51459788337394416547E-12, 1.85594911495471785253E-11, -7.95748924447710747776E-11, 3.57739728140030116597E-10, -1.69753450938905987466E-9, 8.57403401741422608519E-9, -4.66048989768794782956E-8, 2.76681363944501510342E-7, -1.83175552271911948767E-6, 1.39498137188764993662E-5, -1.28495495816278026384E-4, 1.56988388573005337491E-3, -3.14481013119645005427E-2, 2.44030308206595545468E0 }; #endif #ifdef DEC static unsigned short B[] = { 0021703,0106456,0076144,0173406, 0122227,0173144,0116011,0030033, 0022560,0044562,0006506,0067642, 0123101,0076243,0123273,0131013, 0023436,0157713,0056243,0141331, 0124005,0032207,0063726,0164664, 0024344,0066342,0051756,0162300, 0124710,0121365,0154053,0077022, 0025264,0161166,0066246,0077420, 0125647,0141671,0006443,0103212, 0026240,0076431,0077147,0160445, 0126636,0153741,0174002,0105031, 0027243,0040102,0035375,0163073, 0127656,0176256,0113476,0044653, 0030304,0125544,0006377,0130104, 0130751,0047257,0110537,0127324, 0031423,0046400,0014772,0012164, 0132110,0025240,0155247,0112570, 0032624,0105314,0007437,0021574, 0133365,0155243,0174306,0116506, 0034152,0004776,0061643,0102504, 0135006,0136277,0036104,0175023, 0035715,0142217,0162474,0115022, 0137000,0147671,0065177,0134356, 0040434,0026754,0175163,0044070 }; #endif #ifdef IBMPC static unsigned short B[] = { 0x9ee1,0xcf8c,0x71a5,0x3c58, 0x2603,0x9381,0xfecc,0xbc72, 0xcdf4,0x41a8,0x092e,0x3c8e, 0x7641,0x74d7,0x2f94,0xbca8, 0x785b,0x6b94,0xdbf9,0x3cc3, 0xdd36,0xecfa,0xa690,0xbce0, 0xdc98,0x4a7d,0x8d9c,0x3cfc, 0x6fc2,0xbb05,0x145e,0xbd19, 0xcfe2,0xcd94,0x9c4e,0x3d36, 0x70d1,0x21a4,0xf877,0xbd54, 0xfc25,0x2fcc,0x0fa3,0x3d74, 0x5143,0x3f00,0xdafc,0xbd93, 0xbcc7,0x475f,0x6808,0x3db4, 0xc935,0xd2e7,0xdf95,0xbdd5, 0xf608,0x819f,0x956c,0x3df8, 0xf5db,0xf22b,0x29d5,0xbe1d, 0x428e,0x033f,0x69a0,0x3e42, 0xf2af,0x1b54,0x0554,0xbe69, 0xe46f,0x81e3,0x9159,0x3e92, 0xd3a9,0x7f18,0xbb54,0xbebe, 0x70a9,0xcc74,0x413f,0x3eed, 0x9f42,0xe788,0xd797,0xbf20, 0x9342,0xfca7,0xb891,0x3f59, 0xf71e,0x2d4f,0x19f7,0xbfa0, 0x6907,0x9f4e,0x85bd,0x4003 }; #endif #ifdef MIEEE static unsigned short B[] = { 0x3c58,0x71a5,0xcf8c,0x9ee1, 0xbc72,0xfecc,0x9381,0x2603, 0x3c8e,0x092e,0x41a8,0xcdf4, 0xbca8,0x2f94,0x74d7,0x7641, 0x3cc3,0xdbf9,0x6b94,0x785b, 0xbce0,0xa690,0xecfa,0xdd36, 0x3cfc,0x8d9c,0x4a7d,0xdc98, 0xbd19,0x145e,0xbb05,0x6fc2, 0x3d36,0x9c4e,0xcd94,0xcfe2, 0xbd54,0xf877,0x21a4,0x70d1, 0x3d74,0x0fa3,0x2fcc,0xfc25, 0xbd93,0xdafc,0x3f00,0x5143, 0x3db4,0x6808,0x475f,0xbcc7, 0xbdd5,0xdf95,0xd2e7,0xc935, 0x3df8,0x956c,0x819f,0xf608, 0xbe1d,0x29d5,0xf22b,0xf5db, 0x3e42,0x69a0,0x033f,0x428e, 0xbe69,0x0554,0x1b54,0xf2af, 0x3e92,0x9159,0x81e3,0xe46f, 0xbebe,0xbb54,0x7f18,0xd3a9, 0x3eed,0x413f,0xcc74,0x70a9, 0xbf20,0xd797,0xe788,0x9f42, 0x3f59,0xb891,0xfca7,0x9342, 0xbfa0,0x19f7,0x2d4f,0xf71e, 0x4003,0x85bd,0x9f4e,0x6907 }; #endif /* k0.c */ #ifdef ANSIPROT extern double chbevl ( double, void *, int ); extern double md_exp ( double ); extern double i0 ( double ); extern double md_log ( double ); extern double sqrt ( double ); #else double chbevl(), md_exp(), i0(), md_log(), sqrt(); #endif extern double PI; extern double MAXNUM; double k0(x) double x; { double y, z; if( x <= 0.0 ) { mtherr( "k0", DOMAIN ); return( MAXNUM ); } if( x <= 2.0 ) { y = x * x - 2.0; y = chbevl( y, A, 10 ) - md_log( 0.5 * x ) * i0(x); return( y ); } z = 8.0/x - 2.0; y = md_exp(-x) * chbevl( z, B, 25 ) / sqrt(x); return(y); } double k0e( x ) double x; { double y; if( x <= 0.0 ) { mtherr( "k0e", DOMAIN ); return( MAXNUM ); } if( x <= 2.0 ) { y = x * x - 2.0; y = chbevl( y, A, 10 ) - md_log( 0.5 * x ) * i0(x); return( y * md_exp(x) ); } y = chbevl( 8.0/x - 2.0, B, 25 ) / sqrt(x); return(y); } Math-Cephes-0.5306/libmd/ndtri.c0000644000175000017500000002366114757021403016157 0ustar shlomifshlomif/* ndtri.c * * Inverse of Normal distribution function * * * * SYNOPSIS: * * double x, y, ndtri(); * * x = ndtri( y ); * * * * DESCRIPTION: * * Returns the argument, x, for which the area under the * Gaussian probability density function (integrated from * minus infinity to x) is equal to y. * * * For small arguments 0 < y < md_exp(-2), the program computes * z = sqrt( -2.0 * md_log(y) ); then the approximation is * x = z - md_log(z)/z - (1/z) P(1/z) / Q(1/z). * There are two rational functions P/Q, one for 0 < y < md_exp(-32) * and the other for y up to md_exp(-2). For larger arguments, * w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 0.125, 1 5500 9.5e-17 2.1e-17 * DEC 6e-39, 0.135 3500 5.7e-17 1.3e-17 * IEEE 0.125, 1 20000 7.2e-16 1.3e-16 * IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17 * * * ERROR MESSAGES: * * message condition value returned * ndtri domain x <= 0 -MAXNUM * ndtri domain x >= 1 MAXNUM * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier */ #include "mconf.h" extern double MAXNUM; #ifdef UNK /* sqrt(2pi) */ static double s2pi = 2.50662827463100050242E0; #endif #ifdef DEC static unsigned short s2p[] = {0040440,0066230,0177661,0034055}; #define s2pi *(double *)s2p #endif #ifdef IBMPC static unsigned short s2p[] = {0x2706,0x1ff6,0x0d93,0x4004}; #define s2pi *(double *)s2p #endif #ifdef MIEEE static unsigned short s2p[] = { 0x4004,0x0d93,0x1ff6,0x2706 }; #define s2pi *(double *)s2p #endif /* approximation for 0 <= |y - 0.5| <= 3/8 */ #ifdef UNK static double P0[5] = { -5.99633501014107895267E1, 9.80010754185999661536E1, -5.66762857469070293439E1, 1.39312609387279679503E1, -1.23916583867381258016E0, }; static double Q0[8] = { /* 1.00000000000000000000E0,*/ 1.95448858338141759834E0, 4.67627912898881538453E0, 8.63602421390890590575E1, -2.25462687854119370527E2, 2.00260212380060660359E2, -8.20372256168333339912E1, 1.59056225126211695515E1, -1.18331621121330003142E0, }; #endif #ifdef DEC static unsigned short P0[20] = { 0141557,0155170,0071360,0120550, 0041704,0000214,0172417,0067307, 0141542,0132204,0040066,0156723, 0041136,0163161,0157276,0007747, 0140236,0116374,0073666,0051764, }; static unsigned short Q0[32] = { /*0040200,0000000,0000000,0000000,*/ 0040372,0026256,0110403,0123707, 0040625,0122024,0020277,0026661, 0041654,0134161,0124134,0007244, 0142141,0073162,0133021,0131371, 0042110,0041235,0043516,0057767, 0141644,0011417,0036155,0137305, 0041176,0076556,0004043,0125430, 0140227,0073347,0152776,0067251, }; #endif #ifdef IBMPC static unsigned short P0[20] = { 0x142d,0x0e5e,0xfb4f,0xc04d, 0xedd9,0x9ea1,0x8011,0x4058, 0xdbba,0x8806,0x5690,0xc04c, 0xc1fd,0x3bd7,0xdcce,0x402b, 0xca7e,0x8ef6,0xd39f,0xbff3, }; static unsigned short Q0[36] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x74f9,0xd220,0x4595,0x3fff, 0xe5b6,0x8417,0xb482,0x4012, 0x81d4,0x350b,0x970e,0x4055, 0x365f,0x56c2,0x2ece,0xc06c, 0xcbff,0xa8e9,0x0853,0x4069, 0xb7d9,0xe78d,0x8261,0xc054, 0x7563,0xc104,0xcfad,0x402f, 0xcdd5,0xfabf,0xeedc,0xbff2, }; #endif #ifdef MIEEE static unsigned short P0[20] = { 0xc04d,0xfb4f,0x0e5e,0x142d, 0x4058,0x8011,0x9ea1,0xedd9, 0xc04c,0x5690,0x8806,0xdbba, 0x402b,0xdcce,0x3bd7,0xc1fd, 0xbff3,0xd39f,0x8ef6,0xca7e, }; static unsigned short Q0[32] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x3fff,0x4595,0xd220,0x74f9, 0x4012,0xb482,0x8417,0xe5b6, 0x4055,0x970e,0x350b,0x81d4, 0xc06c,0x2ece,0x56c2,0x365f, 0x4069,0x0853,0xa8e9,0xcbff, 0xc054,0x8261,0xe78d,0xb7d9, 0x402f,0xcfad,0xc104,0x7563, 0xbff2,0xeedc,0xfabf,0xcdd5, }; #endif /* Approximation for interval z = sqrt(-2 md_log y ) between 2 and 8 * i.e., y between md_exp(-2) = .135 and md_exp(-32) = 1.27e-14. */ #ifdef UNK static double P1[9] = { 4.05544892305962419923E0, 3.15251094599893866154E1, 5.71628192246421288162E1, 4.40805073893200834700E1, 1.46849561928858024014E1, 2.18663306850790267539E0, -1.40256079171354495875E-1, -3.50424626827848203418E-2, -8.57456785154685413611E-4, }; static double Q1[8] = { /* 1.00000000000000000000E0,*/ 1.57799883256466749731E1, 4.53907635128879210584E1, 4.13172038254672030440E1, 1.50425385692907503408E1, 2.50464946208309415979E0, -1.42182922854787788574E-1, -3.80806407691578277194E-2, -9.33259480895457427372E-4, }; #endif #ifdef DEC static unsigned short P1[36] = { 0040601,0143074,0150744,0073326, 0041374,0031554,0113253,0146016, 0041544,0123272,0012463,0176771, 0041460,0051160,0103560,0156511, 0041152,0172624,0117772,0030755, 0040413,0170713,0151545,0176413, 0137417,0117512,0022154,0131671, 0137017,0104257,0071432,0007072, 0135540,0143363,0063137,0036166, }; static unsigned short Q1[32] = { /*0040200,0000000,0000000,0000000,*/ 0041174,0075325,0004736,0120326, 0041465,0110044,0047561,0045567, 0041445,0042321,0012142,0030340, 0041160,0127074,0166076,0141051, 0040440,0046055,0040745,0150400, 0137421,0114146,0067330,0010621, 0137033,0175162,0025555,0114351, 0135564,0122773,0145750,0030357, }; #endif #ifdef IBMPC static unsigned short P1[36] = { 0x8edb,0x9a3c,0x38c7,0x4010, 0x7982,0x92d5,0x866d,0x403f, 0x7fbf,0x42a6,0x94d7,0x404c, 0x1ba9,0x10ee,0x0a4e,0x4046, 0x463e,0x93ff,0x5eb2,0x402d, 0xbfa1,0x7a6c,0x7e39,0x4001, 0x9677,0x448d,0xf3e9,0xbfc1, 0x41c7,0xee63,0xf115,0xbfa1, 0xe78f,0x6ccb,0x18de,0xbf4c, }; static unsigned short Q1[32] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xd41b,0xa13b,0x8f5a,0x402f, 0x296f,0x89ee,0xb204,0x4046, 0x461c,0x228c,0xa89a,0x4044, 0xd845,0x9d87,0x15c7,0x402e, 0xba20,0xa83c,0x0985,0x4004, 0x0232,0xcddb,0x330c,0xbfc2, 0xb31d,0x456d,0x7f4e,0xbfa3, 0x061e,0x797d,0x94bf,0xbf4e, }; #endif #ifdef MIEEE static unsigned short P1[36] = { 0x4010,0x38c7,0x9a3c,0x8edb, 0x403f,0x866d,0x92d5,0x7982, 0x404c,0x94d7,0x42a6,0x7fbf, 0x4046,0x0a4e,0x10ee,0x1ba9, 0x402d,0x5eb2,0x93ff,0x463e, 0x4001,0x7e39,0x7a6c,0xbfa1, 0xbfc1,0xf3e9,0x448d,0x9677, 0xbfa1,0xf115,0xee63,0x41c7, 0xbf4c,0x18de,0x6ccb,0xe78f, }; static unsigned short Q1[32] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x402f,0x8f5a,0xa13b,0xd41b, 0x4046,0xb204,0x89ee,0x296f, 0x4044,0xa89a,0x228c,0x461c, 0x402e,0x15c7,0x9d87,0xd845, 0x4004,0x0985,0xa83c,0xba20, 0xbfc2,0x330c,0xcddb,0x0232, 0xbfa3,0x7f4e,0x456d,0xb31d, 0xbf4e,0x94bf,0x797d,0x061e, }; #endif /* Approximation for interval z = sqrt(-2 md_log y ) between 8 and 64 * i.e., y between md_exp(-32) = 1.27e-14 and md_exp(-2048) = 3.67e-890. */ #ifdef UNK static double P2[9] = { 3.23774891776946035970E0, 6.91522889068984211695E0, 3.93881025292474443415E0, 1.33303460815807542389E0, 2.01485389549179081538E-1, 1.23716634817820021358E-2, 3.01581553508235416007E-4, 2.65806974686737550832E-6, 6.23974539184983293730E-9, }; static double Q2[8] = { /* 1.00000000000000000000E0,*/ 6.02427039364742014255E0, 3.67983563856160859403E0, 1.37702099489081330271E0, 2.16236993594496635890E-1, 1.34204006088543189037E-2, 3.28014464682127739104E-4, 2.89247864745380683936E-6, 6.79019408009981274425E-9, }; #endif #ifdef DEC static unsigned short P2[36] = { 0040517,0033507,0036236,0125641, 0040735,0044616,0014473,0140133, 0040574,0012567,0114535,0102541, 0040252,0120340,0143474,0150135, 0037516,0051057,0115361,0031211, 0036512,0131204,0101511,0125144, 0035236,0016627,0043160,0140216, 0033462,0060512,0060141,0010641, 0031326,0062541,0101304,0077706, }; static unsigned short Q2[32] = { /*0040200,0000000,0000000,0000000,*/ 0040700,0143322,0132137,0040501, 0040553,0101155,0053221,0140257, 0040260,0041071,0052573,0010004, 0037535,0066472,0177261,0162330, 0036533,0160475,0066666,0036132, 0035253,0174533,0027771,0044027, 0033502,0016147,0117666,0063671, 0031351,0047455,0141663,0054751, }; #endif #ifdef IBMPC static unsigned short P2[36] = { 0xd574,0xe793,0xe6e8,0x4009, 0x780b,0xc327,0xa931,0x401b, 0xb0ac,0xf32b,0x82ae,0x400f, 0x9a0c,0x18e7,0x541c,0x3ff5, 0x2651,0xf35e,0xca45,0x3fc9, 0x354d,0x9069,0x5650,0x3f89, 0x1812,0xe8ce,0xc3b2,0x3f33, 0x2234,0x4c0c,0x4c29,0x3ec6, 0x8ff9,0x3058,0xccac,0x3e3a, }; static unsigned short Q2[32] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xe828,0x568b,0x18da,0x4018, 0x3816,0xaad2,0x704d,0x400d, 0x6200,0x2aaf,0x0847,0x3ff6, 0x3c9b,0x5fd6,0xada7,0x3fcb, 0xc78b,0xadb6,0x7c27,0x3f8b, 0x2903,0x65ff,0x7f2b,0x3f35, 0xccf7,0xf3f6,0x438c,0x3ec8, 0x6b3d,0xb876,0x29e5,0x3e3d, }; #endif #ifdef MIEEE static unsigned short P2[36] = { 0x4009,0xe6e8,0xe793,0xd574, 0x401b,0xa931,0xc327,0x780b, 0x400f,0x82ae,0xf32b,0xb0ac, 0x3ff5,0x541c,0x18e7,0x9a0c, 0x3fc9,0xca45,0xf35e,0x2651, 0x3f89,0x5650,0x9069,0x354d, 0x3f33,0xc3b2,0xe8ce,0x1812, 0x3ec6,0x4c29,0x4c0c,0x2234, 0x3e3a,0xccac,0x3058,0x8ff9, }; static unsigned short Q2[32] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4018,0x18da,0x568b,0xe828, 0x400d,0x704d,0xaad2,0x3816, 0x3ff6,0x0847,0x2aaf,0x6200, 0x3fcb,0xada7,0x5fd6,0x3c9b, 0x3f8b,0x7c27,0xadb6,0xc78b, 0x3f35,0x7f2b,0x65ff,0x2903, 0x3ec8,0x438c,0xf3f6,0xccf7, 0x3e3d,0x29e5,0xb876,0x6b3d, }; #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_log ( double ); extern double sqrt ( double ); #else double polevl(), p1evl(), md_log(), sqrt(); #endif double ndtri(md_y0) double md_y0; { double x, y, z, y2, x0, x1; int code; if( md_y0 <= 0.0 ) { mtherr( "ndtri", DOMAIN ); return( -MAXNUM ); } if( md_y0 >= 1.0 ) { mtherr( "ndtri", DOMAIN ); return( MAXNUM ); } code = 1; y = md_y0; if( y > (1.0 - 0.13533528323661269189) ) /* 0.135... = md_exp(-2) */ { y = 1.0 - y; code = 0; } if( y > 0.13533528323661269189 ) { y = y - 0.5; y2 = y * y; x = y + y * (y2 * polevl( y2, P0, 4)/p1evl( y2, Q0, 8 )); x = x * s2pi; return(x); } x = sqrt( -2.0 * md_log(y) ); x0 = x - md_log(x)/x; z = 1.0/x; if( x < 8.0 ) /* y > md_exp(-32) = 1.2664165549e-14 */ x1 = z * polevl( z, P1, 8 )/p1evl( z, Q1, 8 ); else x1 = z * polevl( z, P2, 8 )/p1evl( z, Q2, 8 ); x = x0 - x1; if( code != 0 ) x = -x; return( x ); } Math-Cephes-0.5306/libmd/j0.c0000644000175000017500000003132014757021403015337 0ustar shlomifshlomif/* md_j0.c * * Bessel function of order zero * * * * SYNOPSIS: * * double x, y, md_j0(); * * y = md_j0( x ); * * * * DESCRIPTION: * * Returns Bessel function of order zero of the argument. * * The domain is divided into the intervals [0, 5] and * (5, infinity). In the first interval the following rational * approximation is used: * * * 2 2 * (w - r ) (w - r ) P (w) / Q (w) * 1 2 3 8 * * 2 * where w = x and the two r's are zeros of the function. * * In the second interval, the Hankel asymptotic expansion * is employed with two rational functions of degree 6/6 * and 7/7. * * * * ACCURACY: * * Absolute error: * arithmetic domain # trials peak rms * DEC 0, 30 10000 4.4e-17 6.3e-18 * IEEE 0, 30 60000 4.2e-16 1.1e-16 * */ /* md_y0.c * * Bessel function of the second kind, order zero * * * * SYNOPSIS: * * double x, y, md_y0(); * * y = md_y0( x ); * * * * DESCRIPTION: * * Returns Bessel function of the second kind, of order * zero, of the argument. * * The domain is divided into the intervals [0, 5] and * (5, infinity). In the first interval a rational approximation * R(x) is employed to compute * md_y0(x) = R(x) + 2 * md_log(x) * md_j0(x) / PI. * Thus a call to md_j0() is required. * * In the second interval, the Hankel asymptotic expansion * is employed with two rational functions of degree 6/6 * and 7/7. * * * * ACCURACY: * * Absolute error, when md_y0(x) < 1; else relative error: * * arithmetic domain # trials peak rms * DEC 0, 30 9400 7.0e-17 7.9e-18 * IEEE 0, 30 30000 1.3e-15 1.6e-16 * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier */ /* Note: all coefficients satisfy the relative error criterion * except YP, YQ which are designed for absolute error. */ #include "mconf.h" #ifdef UNK static double PP[7] = { 7.96936729297347051624E-4, 8.28352392107440799803E-2, 1.23953371646414299388E0, 5.44725003058768775090E0, 8.74716500199817011941E0, 5.30324038235394892183E0, 9.99999999999999997821E-1, }; static double PQ[7] = { 9.24408810558863637013E-4, 8.56288474354474431428E-2, 1.25352743901058953537E0, 5.47097740330417105182E0, 8.76190883237069594232E0, 5.30605288235394617618E0, 1.00000000000000000218E0, }; #endif #ifdef DEC static unsigned short PP[28] = { 0035520,0164604,0140733,0054470, 0037251,0122605,0115356,0107170, 0040236,0124412,0071500,0056303, 0040656,0047737,0045720,0045263, 0041013,0172143,0045004,0142103, 0040651,0132045,0026241,0026406, 0040200,0000000,0000000,0000000, }; static unsigned short PQ[28] = { 0035562,0052006,0070034,0134666, 0037257,0057055,0055242,0123424, 0040240,0071626,0046630,0032371, 0040657,0011077,0032013,0012731, 0041014,0030307,0050331,0006414, 0040651,0145457,0065021,0150304, 0040200,0000000,0000000,0000000, }; #endif #ifdef IBMPC static unsigned short PP[28] = { 0x6b27,0x983b,0x1d30,0x3f4a, 0xd1cf,0xb35d,0x34b0,0x3fb5, 0x0b98,0x4e68,0xd521,0x3ff3, 0x0956,0xe97a,0xc9fb,0x4015, 0x9888,0x6940,0x7e8c,0x4021, 0x25a1,0xa594,0x3684,0x4015, 0x0000,0x0000,0x0000,0x3ff0, }; static unsigned short PQ[28] = { 0x9737,0xce03,0x4a80,0x3f4e, 0x54e3,0xab54,0xebc5,0x3fb5, 0x069f,0xc9b3,0x0e72,0x3ff4, 0x62bb,0xe681,0xe247,0x4015, 0x21a1,0xea1b,0x8618,0x4021, 0x3a19,0xed42,0x3965,0x4015, 0x0000,0x0000,0x0000,0x3ff0, }; #endif #ifdef MIEEE static unsigned short PP[28] = { 0x3f4a,0x1d30,0x983b,0x6b27, 0x3fb5,0x34b0,0xb35d,0xd1cf, 0x3ff3,0xd521,0x4e68,0x0b98, 0x4015,0xc9fb,0xe97a,0x0956, 0x4021,0x7e8c,0x6940,0x9888, 0x4015,0x3684,0xa594,0x25a1, 0x3ff0,0x0000,0x0000,0x0000, }; static unsigned short PQ[28] = { 0x3f4e,0x4a80,0xce03,0x9737, 0x3fb5,0xebc5,0xab54,0x54e3, 0x3ff4,0x0e72,0xc9b3,0x069f, 0x4015,0xe247,0xe681,0x62bb, 0x4021,0x8618,0xea1b,0x21a1, 0x4015,0x3965,0xed42,0x3a19, 0x3ff0,0x0000,0x0000,0x0000, }; #endif #ifdef UNK static double QP[8] = { -1.13663838898469149931E-2, -1.28252718670509318512E0, -1.95539544257735972385E1, -9.32060152123768231369E1, -1.77681167980488050595E2, -1.47077505154951170175E2, -5.14105326766599330220E1, -6.05014350600728481186E0, }; static double QQ[7] = { /* 1.00000000000000000000E0,*/ 6.43178256118178023184E1, 8.56430025976980587198E2, 3.88240183605401609683E3, 7.24046774195652478189E3, 5.93072701187316984827E3, 2.06209331660327847417E3, 2.42005740240291393179E2, }; #endif #ifdef DEC static unsigned short QP[32] = { 0136472,0035021,0142451,0141115, 0140244,0024731,0150620,0105642, 0141234,0067177,0124161,0060141, 0141672,0064572,0151557,0043036, 0142061,0127141,0003127,0043517, 0142023,0011727,0060271,0144544, 0141515,0122142,0126620,0143150, 0140701,0115306,0106715,0007344, }; static unsigned short QQ[28] = { /*0040200,0000000,0000000,0000000,*/ 0041600,0121272,0004741,0026544, 0042526,0015605,0105654,0161771, 0043162,0123155,0165644,0062645, 0043342,0041675,0167576,0130756, 0043271,0052720,0165631,0154214, 0043000,0160576,0034614,0172024, 0042162,0000570,0030500,0051235, }; #endif #ifdef IBMPC static unsigned short QP[32] = { 0x384a,0x38a5,0x4742,0xbf87, 0x1174,0x3a32,0x853b,0xbff4, 0x2c0c,0xf50e,0x8dcf,0xc033, 0xe8c4,0x5a6d,0x4d2f,0xc057, 0xe8ea,0x20ca,0x35cc,0xc066, 0x392d,0xec17,0x627a,0xc062, 0x18cd,0x55b2,0xb48c,0xc049, 0xa1dd,0xd1b9,0x3358,0xc018, }; static unsigned short QQ[28] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x25ac,0x413c,0x1457,0x4050, 0x9c7f,0xb175,0xc370,0x408a, 0x8cb5,0xbd74,0x54cd,0x40ae, 0xd63e,0xbdef,0x4877,0x40bc, 0x3b11,0x1d73,0x2aba,0x40b7, 0x9e82,0xc731,0x1c2f,0x40a0, 0x0a54,0x0628,0x402f,0x406e, }; #endif #ifdef MIEEE static unsigned short QP[32] = { 0xbf87,0x4742,0x38a5,0x384a, 0xbff4,0x853b,0x3a32,0x1174, 0xc033,0x8dcf,0xf50e,0x2c0c, 0xc057,0x4d2f,0x5a6d,0xe8c4, 0xc066,0x35cc,0x20ca,0xe8ea, 0xc062,0x627a,0xec17,0x392d, 0xc049,0xb48c,0x55b2,0x18cd, 0xc018,0x3358,0xd1b9,0xa1dd, }; static unsigned short QQ[28] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4050,0x1457,0x413c,0x25ac, 0x408a,0xc370,0xb175,0x9c7f, 0x40ae,0x54cd,0xbd74,0x8cb5, 0x40bc,0x4877,0xbdef,0xd63e, 0x40b7,0x2aba,0x1d73,0x3b11, 0x40a0,0x1c2f,0xc731,0x9e82, 0x406e,0x402f,0x0628,0x0a54, }; #endif #ifdef UNK static double YP[8] = { 1.55924367855235737965E4, -1.46639295903971606143E7, 5.43526477051876500413E9, -9.82136065717911466409E11, 8.75906394395366999549E13, -3.46628303384729719441E15, 4.42733268572569800351E16, -1.84950800436986690637E16, }; static double YQ[7] = { /* 1.00000000000000000000E0,*/ 1.04128353664259848412E3, 6.26107330137134956842E5, 2.68919633393814121987E8, 8.64002487103935000337E10, 2.02979612750105546709E13, 3.17157752842975028269E15, 2.50596256172653059228E17, }; #endif #ifdef DEC static unsigned short YP[32] = { 0043563,0120677,0042264,0046166, 0146137,0140371,0113444,0042260, 0050241,0175707,0100502,0063344, 0152144,0125737,0007265,0164526, 0053637,0051621,0163035,0060546, 0155105,0004416,0107306,0060023, 0056035,0045133,0030132,0000024, 0155603,0065132,0144061,0131732, }; static unsigned short YQ[28] = { /*0040200,0000000,0000000,0000000,*/ 0042602,0024422,0135557,0162663, 0045030,0155665,0044075,0160135, 0047200,0035432,0105446,0104005, 0051240,0167331,0056063,0022743, 0053223,0127746,0025764,0012160, 0055064,0044206,0177532,0145545, 0056536,0111375,0163715,0127201, }; #endif #ifdef IBMPC static unsigned short YP[32] = { 0x898f,0xe896,0x7437,0x40ce, 0x8896,0x32e4,0xf81f,0xc16b, 0x4cdd,0xf028,0x3f78,0x41f4, 0xbd2b,0xe1d6,0x957b,0xc26c, 0xac2d,0x3cc3,0xea72,0x42d3, 0xcc02,0xd1d8,0xa121,0xc328, 0x4003,0x660b,0xa94b,0x4363, 0x367b,0x5906,0x6d4b,0xc350, }; static unsigned short YQ[28] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xfcb6,0x576d,0x4522,0x4090, 0xbc0c,0xa907,0x1b76,0x4123, 0xd101,0x5164,0x0763,0x41b0, 0x64bc,0x2b86,0x1ddb,0x4234, 0x828e,0xc57e,0x75fc,0x42b2, 0x596d,0xdfeb,0x8910,0x4326, 0xb5d0,0xbcf9,0xd25f,0x438b, }; #endif #ifdef MIEEE static unsigned short YP[32] = { 0x40ce,0x7437,0xe896,0x898f, 0xc16b,0xf81f,0x32e4,0x8896, 0x41f4,0x3f78,0xf028,0x4cdd, 0xc26c,0x957b,0xe1d6,0xbd2b, 0x42d3,0xea72,0x3cc3,0xac2d, 0xc328,0xa121,0xd1d8,0xcc02, 0x4363,0xa94b,0x660b,0x4003, 0xc350,0x6d4b,0x5906,0x367b, }; static unsigned short YQ[28] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4090,0x4522,0x576d,0xfcb6, 0x4123,0x1b76,0xa907,0xbc0c, 0x41b0,0x0763,0x5164,0xd101, 0x4234,0x1ddb,0x2b86,0x64bc, 0x42b2,0x75fc,0xc57e,0x828e, 0x4326,0x8910,0xdfeb,0x596d, 0x438b,0xd25f,0xbcf9,0xb5d0, }; #endif #ifdef UNK /* 5.783185962946784521175995758455807035071 */ static double DR1 = 5.78318596294678452118E0; /* 30.47126234366208639907816317502275584842 */ static double DR2 = 3.04712623436620863991E1; #endif #ifdef DEC static unsigned short R1[] = {0040671,0007734,0001061,0056734}; #define DR1 *(double *)R1 static unsigned short R2[] = {0041363,0142445,0030416,0165567}; #define DR2 *(double *)R2 #endif #ifdef IBMPC static unsigned short R1[] = {0x2bbb,0x8046,0x21fb,0x4017}; #define DR1 *(double *)R1 static unsigned short R2[] = {0xdd6f,0xa621,0x78a4,0x403e}; #define DR2 *(double *)R2 #endif #ifdef MIEEE static unsigned short R1[] = {0x4017,0x21fb,0x8046,0x2bbb}; #define DR1 *(double *)R1 static unsigned short R2[] = {0x403e,0x78a4,0xa621,0xdd6f}; #define DR2 *(double *)R2 #endif #ifdef UNK static double RP[4] = { -4.79443220978201773821E9, 1.95617491946556577543E12, -2.49248344360967716204E14, 9.70862251047306323952E15, }; static double RQ[8] = { /* 1.00000000000000000000E0,*/ 4.99563147152651017219E2, 1.73785401676374683123E5, 4.84409658339962045305E7, 1.11855537045356834862E10, 2.11277520115489217587E12, 3.10518229857422583814E14, 3.18121955943204943306E16, 1.71086294081043136091E18, }; #endif #ifdef DEC static unsigned short RP[16] = { 0150216,0161235,0064344,0014450, 0052343,0135216,0035624,0144153, 0154142,0130247,0003310,0003667, 0055411,0173703,0047772,0176635, }; static unsigned short RQ[32] = { /*0040200,0000000,0000000,0000000,*/ 0042371,0144025,0032265,0136137, 0044451,0133131,0132420,0151466, 0046470,0144641,0072540,0030636, 0050446,0126600,0045042,0044243, 0052365,0172633,0110301,0071063, 0054215,0032424,0062272,0043513, 0055742,0005013,0171731,0072335, 0057275,0170646,0036663,0013134, }; #endif #ifdef IBMPC static unsigned short RP[16] = { 0x8325,0xad1c,0xdc53,0xc1f1, 0x990d,0xc772,0x7751,0x427c, 0x00f7,0xe0d9,0x5614,0xc2ec, 0x5fb4,0x69ff,0x3ef8,0x4341, }; static unsigned short RQ[32] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xb78c,0xa696,0x3902,0x407f, 0x1a67,0x36a2,0x36cb,0x4105, 0x0634,0x2eac,0x1934,0x4187, 0x4914,0x0944,0xd5b0,0x4204, 0x2e46,0x7218,0xbeb3,0x427e, 0x48e9,0x8c97,0xa6a2,0x42f1, 0x2e9c,0x7e7b,0x4141,0x435c, 0x62cc,0xc7b6,0xbe34,0x43b7, }; #endif #ifdef MIEEE static unsigned short RP[16] = { 0xc1f1,0xdc53,0xad1c,0x8325, 0x427c,0x7751,0xc772,0x990d, 0xc2ec,0x5614,0xe0d9,0x00f7, 0x4341,0x3ef8,0x69ff,0x5fb4, }; static unsigned short RQ[32] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x407f,0x3902,0xa696,0xb78c, 0x4105,0x36cb,0x36a2,0x1a67, 0x4187,0x1934,0x2eac,0x0634, 0x4204,0xd5b0,0x0944,0x4914, 0x427e,0xbeb3,0x7218,0x2e46, 0x42f1,0xa6a2,0x8c97,0x48e9, 0x435c,0x4141,0x7e7b,0x2e9c, 0x43b7,0xbe34,0xc7b6,0x62cc, }; #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_log ( double ); extern double md_sin ( double ); extern double md_cos ( double ); extern double sqrt ( double ); double md_j0 ( double ); #else double polevl(), p1evl(), md_log(), md_sin(), md_cos(), sqrt(); double md_j0(); #endif extern double TWOOPI, SQ2OPI, PIO4; double md_j0(x) double x; { double w, z, p, q, xn; if( x < 0 ) x = -x; if( x <= 5.0 ) { z = x * x; if( x < 1.0e-5 ) return( 1.0 - z/4.0 ); p = (z - DR1) * (z - DR2); p = p * polevl( z, RP, 3)/p1evl( z, RQ, 8 ); return( p ); } w = 5.0/x; q = 25.0/(x*x); p = polevl( q, PP, 6)/polevl( q, PQ, 6 ); q = polevl( q, QP, 7)/p1evl( q, QQ, 7 ); xn = x - PIO4; p = p * md_cos(xn) - w * q * md_sin(xn); return( p * SQ2OPI / sqrt(x) ); } /* md_y0() 2 */ /* Bessel function of second kind, order zero */ /* Rational approximation coefficients YP[], YQ[] are used here. * The function computed is md_y0(x) - 2 * md_log(x) * md_j0(x) / PI, * whose value at x = 0 is 2 * ( md_log(0.5) + EUL ) / PI * = 0.073804295108687225. */ /* #define PIO4 .78539816339744830962 #define SQ2OPI .79788456080286535588 */ extern double MAXNUM; double md_y0(x) double x; { double w, z, p, q, xn; if( x <= 5.0 ) { if( x <= 0.0 ) { mtherr( "md_y0", DOMAIN ); return( -MAXNUM ); } z = x * x; w = polevl( z, YP, 7) / p1evl( z, YQ, 7 ); w += TWOOPI * md_log(x) * md_j0(x); return( w ); } w = 5.0/x; z = 25.0 / (x * x); p = polevl( z, PP, 6)/polevl( z, PQ, 6 ); q = polevl( z, QP, 7)/p1evl( z, QQ, 7 ); xn = x - PIO4; p = p * md_sin(xn) + w * q * md_cos(xn); return( p * SQ2OPI / sqrt(x) ); } Math-Cephes-0.5306/libmd/chbevl.c0000644000175000017500000000307314757021403016275 0ustar shlomifshlomif/* chbevl.c * * Evaluate Chebyshev series * * * * SYNOPSIS: * * int N; * double x, y, coef[N], chebevl(); * * y = chbevl( x, coef, N ); * * * * DESCRIPTION: * * Evaluates the series * * N-1 * - ' * y = > coef[i] T (x/2) * - i * i=0 * * of Chebyshev polynomials Ti at argument x/2. * * Coefficients are stored in reverse order, i.e. the zero * order term is last in the array. Note N is the number of * coefficients, not the order. * * If coefficients are for the interval a to b, x must * have been transformed to x -> 2(2x - b - a)/(b-a) before * entering the routine. This maps x from (a, b) to (-1, 1), * over which the Chebyshev polynomials are defined. * * If the coefficients are for the inverted interval, in * which (a, b) is mapped to (1/b, 1/a), the transformation * required is x -> 2(2ab/x - b - a)/(b-a). If b is infinity, * this becomes x -> 4a/x - 1. * * * * SPEED: * * Taking advantage of the recurrence properties of the * Chebyshev polynomials, the routine requires one more * addition per loop than evaluating a nested polynomial of * the same degree. * */ /* chbevl.c */ /* Cephes Math Library Release 2.0: April, 1987 Copyright 1985, 1987 by Stephen L. Moshier Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */ double chbevl( x, array, n ) double x; double array[]; int n; { double b0, b1, b2, *p; int i; p = array; b0 = *p++; b1 = 0.0; i = n - 1; do { b2 = b1; b1 = b0; b0 = x * b1 - b2 + *p++; } while( --i ); return( 0.5*(b0-b2) ); } Math-Cephes-0.5306/libmd/ei.c0000644000175000017500000006336514757021403015441 0ustar shlomifshlomif/* ei.c * * Exponential integral * * * SYNOPSIS: * * double x, y, ei(); * * y = ei( x ); * * * * DESCRIPTION: * * x * - t * | | e * Ei(x) = -|- --- dt . * | | t * - * -inf * * Not defined for x <= 0. * See also md_expn.c. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0,100 50000 8.6e-16 1.3e-16 * */ /* Cephes Math Library Release 2.8: May, 1999 Copyright 1999 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double md_log ( double ); extern double md_exp ( double ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); #else extern double md_log(), md_exp(), polevl(), p1evl(); #endif #define EUL 5.772156649015328606065e-1 /* 0 < x <= 2 Ei(x) - EUL - ln(x) = x A(x)/B(x) Theoretical peak relative error 9.73e-18 */ #if UNK static double A[6] = { -5.350447357812542947283E0, 2.185049168816613393830E2, -4.176572384826693777058E3, 5.541176756393557601232E4, -3.313381331178144034309E5, 1.592627163384945414220E6, }; static double B[6] = { /* 1.000000000000000000000E0, */ -5.250547959112862969197E1, 1.259616186786790571525E3, -1.756549581973534652631E4, 1.493062117002725991967E5, -7.294949239640527645655E5, 1.592627163384945429726E6, }; #endif #if DEC static short A[24] = { 0140653,0033335,0060230,0144217, 0042132,0100502,0035625,0167413, 0143202,0102224,0037176,0175403, 0044130,0071704,0077421,0170343, 0144641,0144504,0041200,0045154, 0045302,0064631,0047234,0142052, }; static short B[24] = { /* 0040200,0000000,0000000,0000000, */ 0141522,0002634,0070442,0142614, 0042635,0071667,0146532,0027705, 0143611,0035375,0156025,0114015, 0044421,0147215,0106177,0046330, 0145062,0014556,0144216,0103725, 0045302,0064631,0047234,0142052, }; #endif #if IBMPC static short A[24] = { 0x1912,0xac13,0x66db,0xc015, 0xbde1,0x4772,0x5028,0x406b, 0xdf60,0x87cf,0x5092,0xc0b0, 0x3e1c,0x8fe2,0x0e78,0x40eb, 0x094e,0x8850,0x3928,0xc114, 0x9885,0x29d3,0x4d33,0x4138, }; static short B[24] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0x58b1,0x8e24,0x40b3,0xc04a, 0x45f9,0xf9ab,0xae76,0x4093, 0xb302,0xbb82,0x275f,0xc0d1, 0xe99b,0xb18f,0x39d1,0x4102, 0xd0fb,0xd911,0x432d,0xc126, 0x9885,0x29d3,0x4d33,0x4138, }; #endif #if MIEEE static short A[24] = { 0xc015,0x66db,0xac13,0x1912, 0x406b,0x5028,0x4772,0xbde1, 0xc0b0,0x5092,0x87cf,0xdf60, 0x40eb,0x0e78,0x8fe2,0x3e1c, 0xc114,0x3928,0x8850,0x094e, 0x4138,0x4d33,0x29d3,0x9885, }; static short B[24] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0xc04a,0x40b3,0x8e24,0x58b1, 0x4093,0xae76,0xf9ab,0x45f9, 0xc0d1,0x275f,0xbb82,0xb302, 0x4102,0x39d1,0xb18f,0xe99b, 0xc126,0x432d,0xd911,0xd0fb, 0x4138,0x4d33,0x29d3,0x9885, }; #endif #if 0 /* 0 < x <= 4 Ei(x) - EUL - ln(x) = x A(x)/B(x) Theoretical peak relative error 4.75e-17 */ #if UNK static double A[7] = { -6.831869820732773831942E0, 2.920190530726774500309E2, -1.195883839286649567993E4, 1.761045255472548975666E5, -2.623034438354006526979E6, 1.472430336917880803157E7, -8.205359388213261174960E7, }; static double B[7] = { /* 1.000000000000000000000E0, */ -7.731946237840033971071E1, 2.751808700543578450827E3, -5.829268609072186897994E4, 7.916610857961870631379E5, -6.873926904825733094076E6, 3.523770183971164032710E7, -8.205359388213260785363E7, }; #endif #if DEC static short A[28] = { 0140732,0117255,0072522,0071743, 0042222,0001160,0052302,0002334, 0143472,0155532,0101650,0155462, 0044453,0175041,0121220,0172022, 0145440,0014351,0140337,0157550, 0046140,0126317,0057202,0100233, 0146634,0100473,0036072,0067054, }; static short B[28] = { /* 0040200,0000000,0000000,0000000, */ 0141632,0121620,0111247,0010115, 0043053,0176360,0067773,0027324, 0144143,0132257,0121644,0036204, 0045101,0043321,0057553,0151231, 0145721,0143215,0147505,0050610, 0046406,0065721,0072675,0152744, 0146634,0100473,0036072,0067052, }; #endif #if IBMPC static short A[28] = { 0x4e7c,0xaeaa,0x53d5,0xc01b, 0x409b,0x0a98,0x404e,0x4072, 0x1b66,0x5075,0x5b6b,0xc0c7, 0x1e82,0x3452,0x7f44,0x4105, 0xfbed,0x381b,0x031d,0xc144, 0x5013,0xebd0,0x1599,0x416c, 0x4dc5,0x6787,0x9027,0xc193, }; static short B[28] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0xe20a,0x1254,0x5472,0xc053, 0x65db,0x0dff,0x7f9e,0x40a5, 0x8791,0xf474,0x7695,0xc0ec, 0x7a53,0x2bed,0x28da,0x4128, 0xaa31,0xb9e8,0x38d1,0xc15a, 0xbabd,0x2eb7,0xcd7a,0x4180, 0x4dc5,0x6787,0x9027,0xc193, }; #endif #if MIEEE static short A[28] = { 0xc01b,0x53d5,0xaeaa,0x4e7c, 0x4072,0x404e,0x0a98,0x409b, 0xc0c7,0x5b6b,0x5075,0x1b66, 0x4105,0x7f44,0x3452,0x1e82, 0xc144,0x031d,0x381b,0xfbed, 0x416c,0x1599,0xebd0,0x5013, 0xc193,0x9027,0x6787,0x4dc5, }; static short B[28] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0xc053,0x5472,0x1254,0xe20a, 0x40a5,0x7f9e,0x0dff,0x65db, 0xc0ec,0x7695,0xf474,0x8791, 0x4128,0x28da,0x2bed,0x7a53, 0xc15a,0x38d1,0xb9e8,0xaa31, 0x4180,0xcd7a,0x2eb7,0xbabd, 0xc193,0x9027,0x6787,0x4dc5, }; #endif #endif /* 0 */ #if 0 /* 0 < x <= 8 Ei(x) - EUL - ln(x) = x A(x)/B(x) Theoretical peak relative error 2.14e-17 */ #if UNK static double A[9] = { -1.111230942210860450145E1, 3.688203982071386319616E2, -4.924786153494029574350E4, 1.050677503345557903241E6, -3.626713709916703688968E7, 4.353499908839918635414E8, -6.454613717232006895409E9, 3.408243056457762907071E10, -1.995466674647028468613E11, }; static double B[9] = { /* 1.000000000000000000000E0, */ -1.356757648138514017969E2, 8.562181317107341736606E3, -3.298257180413775117555E5, 8.543534058481435917210E6, -1.542380618535140055068E8, 1.939251779195993632028E9, -1.636096210465615015435E10, 8.396909743075306970605E10, -1.995466674647028425886E11, }; #endif #if DEC static short A[36] = { 0141061,0146004,0173357,0151553, 0042270,0064402,0147366,0126701, 0144100,0057734,0106615,0144356, 0045200,0040654,0003332,0004456, 0146412,0054440,0043130,0140263, 0047317,0113517,0033422,0065123, 0150300,0056313,0065235,0131147, 0050775,0167423,0146222,0075760, 0151471,0153642,0003442,0147667, }; static short B[36] = { /* 0040200,0000000,0000000,0000000, */ 0142007,0126376,0166077,0043600, 0043405,0144271,0125461,0014364, 0144641,0006066,0175061,0164463, 0046002,0056456,0007370,0121657, 0147023,0013706,0156647,0177115, 0047747,0026504,0103144,0054507, 0150563,0146036,0007051,0177135, 0051234,0063625,0173266,0003111, 0151471,0153642,0003442,0147666, }; #endif #if IBMPC static short A[36] = { 0xfa6d,0x9edd,0x3980,0xc026, 0xd5b8,0x59de,0x0d20,0x4077, 0xb91e,0x91b1,0x0bfb,0xc0e8, 0x4126,0x80db,0x0835,0x4130, 0x1816,0x08cb,0x4b24,0xc181, 0x4d4a,0xe6e2,0xf2e9,0x41b9, 0xb64d,0x6d53,0x0b99,0xc1f8, 0x4f7e,0x7992,0xbde2,0x421f, 0x59f7,0x40e4,0x3af4,0xc247, }; static short B[36] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0xe8f0,0xdd87,0xf59f,0xc060, 0x231e,0x3566,0xb917,0x40c0, 0x3d26,0xdf46,0x2186,0xc114, 0x1476,0xc1df,0x4ba5,0x4160, 0xffca,0xdbb4,0x62f8,0xc1a2, 0x8b29,0x90cc,0xe5a8,0x41dc, 0x3fcc,0xc1c5,0x7983,0xc20e, 0xc0c9,0xbed6,0x8cf2,0x4233, 0x59f7,0x40e4,0x3af4,0xc247, }; #endif #if MIEEE static short A[36] = { 0xc026,0x3980,0x9edd,0xfa6d, 0x4077,0x0d20,0x59de,0xd5b8, 0xc0e8,0x0bfb,0x91b1,0xb91e, 0x4130,0x0835,0x80db,0x4126, 0xc181,0x4b24,0x08cb,0x1816, 0x41b9,0xf2e9,0xe6e2,0x4d4a, 0xc1f8,0x0b99,0x6d53,0xb64d, 0x421f,0xbde2,0x7992,0x4f7e, 0xc247,0x3af4,0x40e4,0x59f7, }; static short B[36] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0xc060,0xf59f,0xdd87,0xe8f0, 0x40c0,0xb917,0x3566,0x231e, 0xc114,0x2186,0xdf46,0x3d26, 0x4160,0x4ba5,0xc1df,0x1476, 0xc1a2,0x62f8,0xdbb4,0xffca, 0x41dc,0xe5a8,0x90cc,0x8b29, 0xc20e,0x7983,0xc1c5,0x3fcc, 0x4233,0x8cf2,0xbed6,0xc0c9, 0xc247,0x3af4,0x40e4,0x59f7, }; #endif #endif /* 0 */ /* 8 <= x <= 20 x md_exp(-x) Ei(x) - 1 = 1/x R(1/x) Theoretical peak absolute error = 1.07e-17 */ #if UNK static double A2[10] = { -2.106934601691916512584E0, 1.732733869664688041885E0, -2.423619178935841904839E-1, 2.322724180937565842585E-2, 2.372880440493179832059E-4, -8.343219561192552752335E-5, 1.363408795605250394881E-5, -3.655412321999253963714E-7, 1.464941733975961318456E-8, 6.176407863710360207074E-10, }; static double B2[9] = { /* 1.000000000000000000000E0, */ -2.298062239901678075778E-1, 1.105077041474037862347E-1, -1.566542966630792353556E-2, 2.761106850817352773874E-3, -2.089148012284048449115E-4, 1.708528938807675304186E-5, -4.459311796356686423199E-7, 1.394634930353847498145E-8, 6.150865933977338354138E-10, }; #endif #if DEC static short A2[40] = { 0140406,0154004,0035104,0173336, 0040335,0145071,0031560,0150165, 0137570,0026670,0176230,0055040, 0036676,0043416,0077122,0054476, 0035170,0150206,0034407,0175571, 0134656,0174121,0123231,0021751, 0034144,0136766,0036746,0121115, 0132704,0037632,0135077,0107300, 0031573,0126321,0117076,0004314, 0030451,0143233,0041352,0172464, }; static short B2[36] = { /* 0040200,0000000,0000000,0000000, */ 0137553,0051122,0120721,0170437, 0037342,0050734,0175047,0032132, 0136600,0052311,0101406,0147050, 0036064,0171657,0120001,0071165, 0135133,0010043,0151244,0066340, 0034217,0051141,0026115,0043305, 0132757,0064120,0106341,0051217, 0031557,0114261,0060663,0135017, 0030451,0011337,0001344,0175542, }; #endif #if IBMPC static short A2[40] = { 0x9edc,0x8748,0xdb00,0xc000, 0x1a0f,0x266e,0xb947,0x3ffb, 0x0b44,0x1f93,0x05b7,0xbfcf, 0x4b28,0xcfca,0xc8e1,0x3f97, 0xff6f,0xc720,0x1a10,0x3f2f, 0x247d,0x34d3,0xdf0a,0xbf15, 0xd44a,0xc7bc,0x97be,0x3eec, 0xf1d8,0x5747,0x87f3,0xbe98, 0xc119,0x33c7,0x759a,0x3e4f, 0x5ea6,0x685d,0x38d3,0x3e05, }; static short B2[36] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0x3e24,0x543a,0x6a4a,0xbfcd, 0xe68b,0x9f44,0x4a3b,0x3fbc, 0xd9c5,0x3060,0x0a99,0xbf90, 0x2e4f,0xf400,0x9e75,0x3f66, 0x8d9c,0x7a54,0x6204,0xbf2b, 0xa8d9,0x2589,0xea4c,0x3ef1, 0x2a52,0x119c,0xed0a,0xbe9d, 0x7742,0x2c36,0xf316,0x3e4d, 0x9f6c,0xe05c,0x225b,0x3e05, }; #endif #if MIEEE static short A2[40] = { 0xc000,0xdb00,0x8748,0x9edc, 0x3ffb,0xb947,0x266e,0x1a0f, 0xbfcf,0x05b7,0x1f93,0x0b44, 0x3f97,0xc8e1,0xcfca,0x4b28, 0x3f2f,0x1a10,0xc720,0xff6f, 0xbf15,0xdf0a,0x34d3,0x247d, 0x3eec,0x97be,0xc7bc,0xd44a, 0xbe98,0x87f3,0x5747,0xf1d8, 0x3e4f,0x759a,0x33c7,0xc119, 0x3e05,0x38d3,0x685d,0x5ea6, }; static short B2[36] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0xbfcd,0x6a4a,0x543a,0x3e24, 0x3fbc,0x4a3b,0x9f44,0xe68b, 0xbf90,0x0a99,0x3060,0xd9c5, 0x3f66,0x9e75,0xf400,0x2e4f, 0xbf2b,0x6204,0x7a54,0x8d9c, 0x3ef1,0xea4c,0x2589,0xa8d9, 0xbe9d,0xed0a,0x119c,0x2a52, 0x3e4d,0xf316,0x2c36,0x7742, 0x3e05,0x225b,0xe05c,0x9f6c, }; #endif /* x > 20 x md_exp(-x) Ei(x) - 1 = 1/x A3(1/x)/B3(1/x) Theoretical absolute error = 6.15e-17 */ #if UNK static double A3[9] = { -7.657847078286127362028E-1, 6.886192415566705051750E-1, -2.132598113545206124553E-1, 3.346107552384193813594E-2, -3.076541477344756050249E-3, 1.747119316454907477380E-4, -6.103711682274170530369E-6, 1.218032765428652199087E-7, -1.086076102793290233007E-9, }; static double B3[9] = { /* 1.000000000000000000000E0, */ -1.888802868662308731041E0, 1.066691687211408896850E0, -2.751915982306380647738E-1, 3.930852688233823569726E-2, -3.414684558602365085394E-3, 1.866844370703555398195E-4, -6.345146083130515357861E-6, 1.239754287483206878024E-7, -1.086076102793126632978E-9, }; #endif #if DEC static short A3[36] = { 0140104,0005167,0071746,0115510, 0040060,0044531,0140741,0154556, 0137532,0060307,0126506,0071123, 0037011,0007173,0010405,0127224, 0136111,0117715,0003654,0175577, 0035067,0031340,0102657,0147714, 0133714,0147173,0167473,0136640, 0032402,0144407,0115547,0060114, 0130625,0042347,0156431,0113425, }; static short B3[36] = { /* 0040200,0000000,0000000,0000000, */ 0140361,0142112,0155277,0067714, 0040210,0104532,0065676,0074326, 0137614,0162751,0142421,0131033, 0037041,0000772,0053236,0002632, 0136137,0144346,0100536,0153136, 0035103,0140270,0152211,0166215, 0133724,0164143,0145763,0021153, 0032405,0017033,0035333,0025736, 0130625,0042347,0156431,0077134, }; #endif #if IBMPC static short A3[36] = { 0xd369,0xee7c,0x814e,0xbfe8, 0x3b2e,0x383c,0x092b,0x3fe6, 0xce4a,0xf5a8,0x4c18,0xbfcb, 0xb5d2,0x6220,0x21cf,0x3fa1, 0x9f70,0xa0f5,0x33f9,0xbf69, 0xf9f9,0x10b5,0xe65c,0x3f26, 0x77b4,0x7de7,0x99cf,0xbed9, 0xec09,0xf36c,0x5920,0x3e80, 0x32e3,0xfba3,0xa89c,0xbe12, }; static short B3[36] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0xedf9,0x5b57,0x3889,0xbffe, 0xcf1b,0x4d77,0x112b,0x3ff1, 0x3643,0x38a2,0x9cbd,0xbfd1, 0xc0b3,0x4ad3,0x203f,0x3fa4, 0xdacc,0xd02b,0xf91c,0xbf6b, 0x3d92,0x1a91,0x7817,0x3f28, 0x644d,0x797e,0x9d0c,0xbeda, 0x657c,0x675b,0xa3c3,0x3e80, 0x2fcb,0xfba3,0xa89c,0xbe12, }; #endif #if MIEEE static short A3[36] = { 0xbfe8,0x814e,0xee7c,0xd369, 0x3fe6,0x092b,0x383c,0x3b2e, 0xbfcb,0x4c18,0xf5a8,0xce4a, 0x3fa1,0x21cf,0x6220,0xb5d2, 0xbf69,0x33f9,0xa0f5,0x9f70, 0x3f26,0xe65c,0x10b5,0xf9f9, 0xbed9,0x99cf,0x7de7,0x77b4, 0x3e80,0x5920,0xf36c,0xec09, 0xbe12,0xa89c,0xfba3,0x32e3, }; static short B3[36] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0xbffe,0x3889,0x5b57,0xedf9, 0x3ff1,0x112b,0x4d77,0xcf1b, 0xbfd1,0x9cbd,0x38a2,0x3643, 0x3fa4,0x203f,0x4ad3,0xc0b3, 0xbf6b,0xf91c,0xd02b,0xdacc, 0x3f28,0x7817,0x1a91,0x3d92, 0xbeda,0x9d0c,0x797e,0x644d, 0x3e80,0xa3c3,0x675b,0x657c, 0xbe12,0xa89c,0xfba3,0x2fcb, }; #endif /* 16 <= x <= 32 x md_exp(-x) Ei(x) - 1 = 1/x A4(1/x) / B4(1/x) Theoretical absolute error = 1.22e-17 */ #if UNK static double A4[8] = { -2.458119367674020323359E-1, -1.483382253322077687183E-1, 7.248291795735551591813E-2, -1.348315687380940523823E-2, 1.342775069788636972294E-3, -7.942465637159712264564E-5, 2.644179518984235952241E-6, -4.239473659313765177195E-8, }; static double B4[8] = { /* 1.000000000000000000000E0, */ -1.044225908443871106315E-1, -2.676453128101402655055E-1, 9.695000254621984627876E-2, -1.601745692712991078208E-2, 1.496414899205908021882E-3, -8.462452563778485013756E-5, 2.728938403476726394024E-6, -4.239462431819542051337E-8, }; #endif #if DEC static short A4[32] = { 0137573,0133037,0152607,0113356, 0137427,0162771,0145061,0126345, 0037224,0070754,0110451,0174104, 0136534,0164165,0072170,0063753, 0035660,0000016,0002560,0147751, 0134646,0110311,0123316,0047432, 0033461,0071250,0101031,0075202, 0132066,0012601,0077305,0170177, }; static short B4[32] = { /* 0040200,0000000,0000000,0000000, */ 0137325,0155602,0162437,0030710, 0137611,0004316,0071344,0176361, 0037306,0106671,0011103,0155053, 0136603,0033412,0132530,0175171, 0035704,0021532,0015516,0166130, 0134661,0074162,0036741,0073466, 0033467,0021316,0003100,0171325, 0132066,0012541,0162202,0150160, }; #endif #if IBMPC static short A4[] = { 0xf2de,0xfab0,0x76c3,0xbfcf, 0x359d,0x3946,0xfcbf,0xbfc2, 0x3f09,0x9225,0x8e3d,0x3fb2, 0x0cfd,0xae8f,0x9d0e,0xbf8b, 0x19fd,0xc0ae,0x0001,0x3f56, 0xc9e3,0x34d9,0xd219,0xbf14, 0x2f50,0x1043,0x2e55,0x3ec6, 0xbe10,0x2fd8,0xc2b0,0xbe66, }; static short B4[] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0xe639,0x5ca3,0xbb70,0xbfba, 0x9f9e,0xce5c,0x2119,0xbfd1, 0x7b45,0x2248,0xd1b7,0x3fb8, 0x1f4f,0x56ab,0x66e1,0xbf90, 0xdd8b,0x4369,0x846b,0x3f58, 0x2ee7,0x47bc,0x2f0e,0xbf16, 0x1e5b,0xc0c8,0xe459,0x3ec6, 0x5a0e,0x3c90,0xc2ac,0xbe66, }; #endif #if MIEEE static short A4[32] = { 0xbfcf,0x76c3,0xfab0,0xf2de, 0xbfc2,0xfcbf,0x3946,0x359d, 0x3fb2,0x8e3d,0x9225,0x3f09, 0xbf8b,0x9d0e,0xae8f,0x0cfd, 0x3f56,0x0001,0xc0ae,0x19fd, 0xbf14,0xd219,0x34d9,0xc9e3, 0x3ec6,0x2e55,0x1043,0x2f50, 0xbe66,0xc2b0,0x2fd8,0xbe10, }; static short B4[32] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0xbfba,0xbb70,0x5ca3,0xe639, 0xbfd1,0x2119,0xce5c,0x9f9e, 0x3fb8,0xd1b7,0x2248,0x7b45, 0xbf90,0x66e1,0x56ab,0x1f4f, 0x3f58,0x846b,0x4369,0xdd8b, 0xbf16,0x2f0e,0x47bc,0x2ee7, 0x3ec6,0xe459,0xc0c8,0x1e5b, 0xbe66,0xc2ac,0x3c90,0x5a0e, }; #endif #if 0 /* 20 <= x <= 40 x md_exp(-x) Ei(x) - 1 = 1/x A4(1/x) / B4(1/x) Theoretical absolute error = 1.78e-17 */ #if UNK static double A4[8] = { 2.067245813525780707978E-1, -5.153749551345223645670E-1, 1.928289589546695033096E-1, -3.124468842857260044075E-2, 2.740283734277352539912E-3, -1.377775664366875175601E-4, 3.803788980664744242323E-6, -4.611038277393688031154E-8, }; static double B4[8] = { /* 1.000000000000000000000E0, */ -8.544436025219516861531E-1, 2.507436807692907385181E-1, -3.647688090228423114064E-2, 3.008576950332041388892E-3, -1.452926405348421286334E-4, 3.896007735260115431965E-6, -4.611037642697098234083E-8, }; #endif #if DEC static short A4[32] = { 0037523,0127633,0150301,0022031, 0140003,0167634,0170572,0170420, 0037505,0072364,0060672,0063220, 0136777,0172334,0057456,0102640, 0036063,0113125,0002476,0047251, 0135020,0074142,0042600,0043630, 0033577,0042230,0155372,0136105, 0132106,0005346,0165333,0114541, }; static short B4[28] = { /* 0040200,0000000,0000000,0000000, */ 0140132,0136320,0160433,0131535, 0037600,0060571,0144452,0060214, 0137025,0064310,0024220,0176472, 0036105,0025613,0115762,0166605, 0135030,0054662,0035454,0061763, 0033602,0135163,0116430,0000066, 0132106,0005345,0020602,0137133, }; #endif #if IBMPC static short A4[32] = { 0x2483,0x7a18,0x75f3,0x3fca, 0x5e22,0x9e2f,0x7df3,0xbfe0, 0x4cd2,0x8c37,0xae9e,0x3fc8, 0xd0b4,0x8be5,0xfe9b,0xbf9f, 0xc9d5,0xa0a7,0x72ca,0x3f66, 0x08f3,0x48b0,0x0f0c,0xbf22, 0x5789,0x1b5f,0xe893,0x3ecf, 0x732c,0xdd5b,0xc15c,0xbe68, }; static short B4[28] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0x766c,0x1c23,0x579a,0xbfeb, 0x4c11,0x3925,0x0c2f,0x3fd0, 0x1fa7,0x0512,0xad19,0xbfa2, 0x5db1,0x737e,0xa571,0x3f68, 0x8c7e,0x4765,0x0b36,0xbf23, 0x0007,0x73a3,0x574e,0x3ed0, 0x57cb,0xa430,0xc15c,0xbe68, }; #endif #if MIEEE static short A4[32] = { 0x3fca,0x75f3,0x7a18,0x2483, 0xbfe0,0x7df3,0x9e2f,0x5e22, 0x3fc8,0xae9e,0x8c37,0x4cd2, 0xbf9f,0xfe9b,0x8be5,0xd0b4, 0x3f66,0x72ca,0xa0a7,0xc9d5, 0xbf22,0x0f0c,0x48b0,0x08f3, 0x3ecf,0xe893,0x1b5f,0x5789, 0xbe68,0xc15c,0xdd5b,0x732c, }; static short B4[28] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0xbfeb,0x579a,0x1c23,0x766c, 0x3fd0,0x0c2f,0x3925,0x4c11, 0xbfa2,0xad19,0x0512,0x1fa7, 0x3f68,0xa571,0x737e,0x5db1, 0xbf23,0x0b36,0x4765,0x8c7e, 0x3ed0,0x574e,0x73a3,0x0007, 0xbe68,0xc15c,0xa430,0x57cb, }; #endif #endif /* 0 */ /* 4 <= x <= 8 x md_exp(-x) Ei(x) - 1 = 1/x A5(1/x) / B5(1/x) Theoretical absolute error = 2.20e-17 */ #if UNK static double A5[8] = { -1.373215375871208729803E0, -7.084559133740838761406E-1, 1.580806855547941010501E0, -2.601500427425622944234E-1, 2.994674694113713763365E-2, -1.038086040188744005513E-3, 4.371064420753005429514E-5, 2.141783679522602903795E-6, }; static double B5[8] = { /* 1.000000000000000000000E0, */ 8.585231423622028380768E-1, 4.483285822873995129957E-1, 7.687932158124475434091E-2, 2.449868241021887685904E-2, 8.832165941927796567926E-4, 4.590952299511353531215E-4, -4.729848351866523044863E-6, 2.665195537390710170105E-6, }; #endif #if DEC static short A5[32] = { 0140257,0142605,0076335,0113632, 0140065,0056535,0161231,0074311, 0040312,0053741,0004357,0076405, 0137605,0031142,0165503,0136705, 0036765,0051341,0053573,0007602, 0135610,0010143,0027643,0110522, 0034467,0052762,0062024,0120161, 0033417,0135620,0036500,0062647, }; static short B[32] = { /* 0040200,0000000,0000000,0000000, */ 0040133,0144054,0031516,0004100, 0037745,0105522,0166622,0123146, 0037235,0071347,0157560,0157464, 0036710,0130565,0173747,0041670, 0035547,0103651,0106243,0101240, 0035360,0131267,0176263,0140257, 0133636,0132426,0102537,0102531, 0033462,0155665,0167503,0176350, }; #endif #if IBMPC static short A5[32] = { 0xb2f3,0xaf9b,0xf8b0,0xbff5, 0x2f19,0xbc53,0xabab,0xbfe6, 0xefa1,0x211d,0x4afc,0x3ff9, 0x77b9,0x5d68,0xa64c,0xbfd0, 0x61f0,0x2aef,0xaa5c,0x3f9e, 0x722a,0x65f4,0x020c,0xbf51, 0x940e,0x4c82,0xeabe,0x3f06, 0x0cb5,0x07a8,0xf772,0x3ec1, }; static short B5[32] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0xc108,0x8669,0x7905,0x3feb, 0x54cd,0x5db2,0xb16a,0x3fdc, 0x1be7,0xfbee,0xae5c,0x3fb3, 0xe877,0xbefc,0x162e,0x3f99, 0x7054,0x3194,0xf0f5,0x3f4c, 0x7816,0xff96,0x1656,0x3f3e, 0xf0ab,0xd0ab,0xd6a2,0xbed3, 0x7f9d,0xbde8,0x5b76,0x3ec6, }; #endif #if MIEEE static short A5[32] = { 0xbff5,0xf8b0,0xaf9b,0xb2f3, 0xbfe6,0xabab,0xbc53,0x2f19, 0x3ff9,0x4afc,0x211d,0xefa1, 0xbfd0,0xa64c,0x5d68,0x77b9, 0x3f9e,0xaa5c,0x2aef,0x61f0, 0xbf51,0x020c,0x65f4,0x722a, 0x3f06,0xeabe,0x4c82,0x940e, 0x3ec1,0xf772,0x07a8,0x0cb5, }; static short B5[32] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0x3feb,0x7905,0x8669,0xc108, 0x3fdc,0xb16a,0x5db2,0x54cd, 0x3fb3,0xae5c,0xfbee,0x1be7, 0x3f99,0x162e,0xbefc,0xe877, 0x3f4c,0xf0f5,0x3194,0x7054, 0x3f3e,0x1656,0xff96,0x7816, 0xbed3,0xd6a2,0xd0ab,0xf0ab, 0x3ec6,0x5b76,0xbde8,0x7f9d, }; #endif /* 2 <= x <= 4 x md_exp(-x) Ei(x) - 1 = 1/x A6(1/x) / B6(1/x) Theoretical absolute error = 4.89e-17 */ #if UNK static double A6[8] = { 1.981808503259689673238E-2, -1.271645625984917501326E0, -2.088160335681228318920E0, 2.755544509187936721172E0, -4.409507048701600257171E-1, 4.665623805935891391017E-2, -1.545042679673485262580E-3, 7.059980605299617478514E-5, }; static double B6[7] = { /* 1.000000000000000000000E0, */ 1.476498670914921440652E0, 5.629177174822436244827E-1, 1.699017897879307263248E-1, 2.291647179034212017463E-2, 4.450150439728752875043E-3, 1.727439612206521482874E-4, 3.953167195549672482304E-5, }; #endif #if DEC static short A6[32] = { 0036642,0054611,0061263,0000140, 0140242,0142510,0125732,0072035, 0140405,0122153,0037643,0104527, 0040460,0055327,0055550,0116240, 0137741,0142112,0070441,0103510, 0037077,0015234,0104750,0146765, 0135712,0101407,0107554,0020253, 0034624,0007373,0072621,0063735, }; static short B6[28] = { /* 0040200,0000000,0000000,0000000, */ 0040274,0176750,0110025,0061006, 0040020,0015540,0021354,0155050, 0037455,0175274,0015257,0021112, 0036673,0135523,0016042,0117203, 0036221,0151221,0046352,0144174, 0035065,0021232,0117727,0152432, 0034445,0147317,0037300,0067123, }; #endif #if IBMPC static short A6[32] = { 0x600c,0x2c56,0x4b31,0x3f94, 0x4e84,0x157b,0x58a9,0xbff4, 0x712b,0x67f4,0xb48d,0xc000, 0x1394,0xeb6d,0x0b5a,0x4006, 0x30e9,0x4e24,0x3889,0xbfdc, 0x19bf,0x913d,0xe353,0x3fa7, 0x8415,0xf1ed,0x5060,0xbf59, 0x2cfc,0x6eb2,0x81df,0x3f12, }; static short B6[28] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0xac41,0x1202,0x9fbd,0x3ff7, 0x9b45,0x045d,0x036c,0x3fe2, 0xe449,0x8355,0xbf57,0x3fc5, 0x53d0,0x6384,0x776a,0x3f97, 0x590f,0x299d,0x3a52,0x3f72, 0xfaa3,0x53fa,0xa453,0x3f26, 0x0dca,0xe7d8,0xb9d9,0x3f04, }; #endif #if MIEEE static short A6[32] = { 0x3f94,0x4b31,0x2c56,0x600c, 0xbff4,0x58a9,0x157b,0x4e84, 0xc000,0xb48d,0x67f4,0x712b, 0x4006,0x0b5a,0xeb6d,0x1394, 0xbfdc,0x3889,0x4e24,0x30e9, 0x3fa7,0xe353,0x913d,0x19bf, 0xbf59,0x5060,0xf1ed,0x8415, 0x3f12,0x81df,0x6eb2,0x2cfc, }; static short B6[28] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0x3ff7,0x9fbd,0x1202,0xac41, 0x3fe2,0x036c,0x045d,0x9b45, 0x3fc5,0xbf57,0x8355,0xe449, 0x3f97,0x776a,0x6384,0x53d0, 0x3f72,0x3a52,0x299d,0x590f, 0x3f26,0xa453,0x53fa,0xfaa3, 0x3f04,0xb9d9,0xe7d8,0x0dca, }; #endif /* 32 <= x <= 64 x md_exp(-x) Ei(x) - 1 = 1/x A7(1/x) / B7(1/x) Theoretical absolute error = 7.71e-18 */ #if UNK static double A7[6] = { 1.212561118105456670844E-1, -5.823133179043894485122E-1, 2.348887314557016779211E-1, -3.040034318113248237280E-2, 1.510082146865190661777E-3, -2.523137095499571377122E-5, }; static double B7[5] = { /* 1.000000000000000000000E0, */ -1.002252150365854016662E0, 2.928709694872224144953E-1, -3.337004338674007801307E-2, 1.560544881127388842819E-3, -2.523137093603234562648E-5, }; #endif #if DEC static short A7[24] = { 0037370,0052437,0152524,0150125, 0140025,0011174,0050154,0131330, 0037560,0103253,0167464,0062245, 0136771,0005043,0174001,0023345, 0035705,0166762,0157300,0016451, 0134323,0123764,0157767,0134477, }; static short B7[20] = { /* 0040200,0000000,0000000,0000000, */ 0140200,0044714,0064025,0060324, 0037625,0171457,0003712,0073131, 0137010,0127406,0150061,0141746, 0035714,0105462,0072356,0103712, 0134323,0123764,0156514,0077414, }; #endif #if IBMPC static short A7[24] = { 0x9a0b,0xfaaa,0x0aa3,0x3fbf, 0x965b,0x8a0d,0xa24f,0xbfe2, 0x8c95,0x7de6,0x10d5,0x3fce, 0x24dd,0x7f00,0x2144,0xbf9f, 0x03a5,0x5bd8,0xbdbe,0x3f58, 0xf728,0x9bfe,0x74fe,0xbefa, }; static short B7[20] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0xac1a,0x8d02,0x0939,0xbff0, 0x4ecb,0xe0f9,0xbe65,0x3fd2, 0x387d,0xda06,0x15e0,0xbfa1, 0xd0f9,0x4e9d,0x9166,0x3f59, 0x8fe2,0x9ba9,0x74fe,0xbefa, }; #endif #if MIEEE static short A7[24] = { 0x3fbf,0x0aa3,0xfaaa,0x9a0b, 0xbfe2,0xa24f,0x8a0d,0x965b, 0x3fce,0x10d5,0x7de6,0x8c95, 0xbf9f,0x2144,0x7f00,0x24dd, 0x3f58,0xbdbe,0x5bd8,0x03a5, 0xbefa,0x74fe,0x9bfe,0xf728, }; static short B7[20] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0xbff0,0x0939,0x8d02,0xac1a, 0x3fd2,0xbe65,0xe0f9,0x4ecb, 0xbfa1,0x15e0,0xda06,0x387d, 0x3f59,0x9166,0x4e9d,0xd0f9, 0xbefa,0x74fe,0x9ba9,0x8fe2, }; #endif double ei (x) double x; { double f, w; if (x <= 0.0) { mtherr("ei", DOMAIN); return 0.0; } else if (x < 2.0) { /* Power series. inf n - x Ei(x) = EUL + ln x + > ---- - n n! n=1 */ f = polevl(x,A,5) / p1evl(x,B,6); /* f = polevl(x,A,6) / p1evl(x,B,7); */ /* f = polevl(x,A,8) / p1evl(x,B,9); */ return (EUL + md_log(x) + x * f); } else if (x < 4.0) { /* Asymptotic expansion. 1 2 6 x md_exp(-x) Ei(x) = 1 + --- + --- + ---- + ... x 2 3 x x */ w = 1.0/x; f = polevl(w,A6,7) / p1evl(w,B6,7); return (md_exp(x) * w * (1.0 + w * f)); } else if (x < 8.0) { w = 1.0/x; f = polevl(w,A5,7) / p1evl(w,B5,8); return (md_exp(x) * w * (1.0 + w * f)); } else if (x < 16.0) { w = 1.0/x; f = polevl(w,A2,9) / p1evl(w,B2,9); return (md_exp(x) * w * (1.0 + w * f)); } else if (x < 32.0) { w = 1.0/x; f = polevl(w,A4,7) / p1evl(w,B4,8); return (md_exp(x) * w * (1.0 + w * f)); } else if (x < 64.0) { w = 1.0/x; f = polevl(w,A7,5) / p1evl(w,B7,5); return (md_exp(x) * w * (1.0 + w * f)); } else { w = 1.0/x; f = polevl(w,A3,8) / p1evl(w,B3,9); return (md_exp(x) * w * (1.0 + w * f)); } } Math-Cephes-0.5306/libmd/floor.c0000644000175000017500000001423614757021403016156 0ustar shlomifshlomif/* md_ceil() * md_floor() * md_frexp() * md_ldexp() * signbit() * isnan() * isfinite() * * Floating point numeric utilities * * * * SYNOPSIS: * * double md_ceil(), md_floor(), md_frexp(), md_ldexp(); * int signbit(), isnan(), isfinite(); * double x, y; * int expnt, n; * * y = md_floor(x); * y = md_ceil(x); * y = md_frexp( x, &expnt ); * y = md_ldexp( x, n ); * n = signbit(x); * n = isnan(x); * n = isfinite(x); * * * * DESCRIPTION: * * All four routines return a double precision floating point * result. * * md_floor() returns the largest integer less than or equal to x. * It truncates toward minus infinity. * * md_ceil() returns the smallest integer greater than or equal * to x. It truncates toward plus infinity. * * md_frexp() extracts the exponent from x. It returns an integer * power of two to expnt and the significand between 0.5 and 1 * to y. Thus x = y * 2**md_expn. * * md_ldexp() multiplies x by 2**n. * * signbit(x) returns 1 if the sign bit of x is 1, else 0. * * These functions are part of the standard C run time library * for many but not all C compilers. The ones supplied are * written in C for either DEC or IEEE arithmetic. They should * be used only if your compiler library does not already have * them. * * The IEEE versions assume that denormal numbers are implemented * in the arithmetic. Some modifications will be required if * the arithmetic has abrupt rather than gradual underflow. */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK /* md_ceil(), md_floor(), md_frexp(), md_ldexp() may need to be rewritten. */ #undef UNK #if BIGENDIAN #define MIEEE 1 #else #define IBMPC 1 #endif #endif #ifdef DEC #define EXPMSK 0x807f #define MEXP 255 #define NBITS 56 #endif #ifdef IBMPC #define EXPMSK 0x800f #define MEXP 0x7ff #define NBITS 53 #endif #ifdef MIEEE #define EXPMSK 0x800f #define MEXP 0x7ff #define NBITS 53 #endif extern double MAXNUM, NEGZERO; #ifdef ANSIPROT double md_floor ( double ); int isnan ( double ); int isfinite ( double ); double md_ldexp ( double, int ); #else double md_floor(); int isnan(), isfinite(); double md_ldexp(); #endif double md_ceil(x) double x; { double y; #ifdef UNK mtherr( "md_ceil", DOMAIN ); return(0.0); #endif #ifdef NANS if( isnan(x) ) return( x ); #endif #ifdef INFINITIES if(!isfinite(x)) return(x); #endif y = md_floor(x); if( y < x ) y += 1.0; #ifdef MINUSZERO if( y == 0.0 && x < 0.0 ) return( NEGZERO ); #endif return(y); } /* Bit clearing masks: */ static unsigned short bmask[] = { 0xffff, 0xfffe, 0xfffc, 0xfff8, 0xfff0, 0xffe0, 0xffc0, 0xff80, 0xff00, 0xfe00, 0xfc00, 0xf800, 0xf000, 0xe000, 0xc000, 0x8000, 0x0000, }; double md_floor(x) double x; { union { double y; unsigned short sh[4]; } u; unsigned short *p; int e; #ifdef UNK mtherr( "md_floor", DOMAIN ); return(0.0); #endif #ifdef NANS if( isnan(x) ) return( x ); #endif #ifdef INFINITIES if(!isfinite(x)) return(x); #endif #ifdef MINUSZERO if(x == 0.0L) return(x); #endif u.y = x; /* find the exponent (power of 2) */ #ifdef DEC p = (unsigned short *)&u.sh[0]; e = (( *p >> 7) & 0377) - 0201; p += 3; #endif #ifdef IBMPC p = (unsigned short *)&u.sh[3]; e = (( *p >> 4) & 0x7ff) - 0x3ff; p -= 3; #endif #ifdef MIEEE p = (unsigned short *)&u.sh[0]; e = (( *p >> 4) & 0x7ff) - 0x3ff; p += 3; #endif if( e < 0 ) { if( u.y < 0.0 ) return( -1.0 ); else return( 0.0 ); } e = (NBITS -1) - e; /* clean out 16 bits at a time */ while( e >= 16 ) { #ifdef IBMPC *p++ = 0; #endif #ifdef DEC *p-- = 0; #endif #ifdef MIEEE *p-- = 0; #endif e -= 16; } /* clear the remaining bits */ if( e > 0 ) *p &= bmask[e]; if( (x < 0) && (u.y != x) ) u.y -= 1.0; return(u.y); } double md_frexp( x, pw2 ) double x; int *pw2; { union { double y; unsigned short sh[4]; } u; int i; #ifdef DENORMAL int k; #endif short *q; u.y = x; #ifdef UNK mtherr( "md_frexp", DOMAIN ); return(0.0); #endif #ifdef IBMPC q = (short *)&u.sh[3]; #endif #ifdef DEC q = (short *)&u.sh[0]; #endif #ifdef MIEEE q = (short *)&u.sh[0]; #endif /* find the exponent (power of 2) */ #ifdef DEC i = ( *q >> 7) & 0377; if( i == 0 ) { *pw2 = 0; return(0.0); } i -= 0200; *pw2 = i; *q &= 0x807f; /* strip all exponent bits */ *q |= 040000; /* mantissa between 0.5 and 1 */ return(u.y); #endif #ifdef IBMPC i = ( *q >> 4) & 0x7ff; if( i != 0 ) goto ieeedon; #endif #ifdef MIEEE i = *q >> 4; i &= 0x7ff; if( i != 0 ) goto ieeedon; #ifdef DENORMAL #else *pw2 = 0; return(0.0); #endif #endif #ifndef DEC /* Number is denormal or zero */ #ifdef DENORMAL if( u.y == 0.0 ) { *pw2 = 0; return( 0.0 ); } /* Handle denormal number. */ do { u.y *= 2.0; i -= 1; k = ( *q >> 4) & 0x7ff; } while( k == 0 ); i = i + k; #endif /* DENORMAL */ ieeedon: i -= 0x3fe; *pw2 = i; *q &= 0x800f; *q |= 0x3fe0; return( u.y ); #endif } double md_ldexp( x, pw2 ) double x; int pw2; { union { double y; unsigned short sh[4]; } u; short *q; int e; #ifdef UNK mtherr( "md_ldexp", DOMAIN ); return(0.0); #endif u.y = x; #ifdef DEC q = (short *)&u.sh[0]; e = ( *q >> 7) & 0377; if( e == 0 ) return(0.0); #else #ifdef IBMPC q = (short *)&u.sh[3]; #endif #ifdef MIEEE q = (short *)&u.sh[0]; #endif while( (e = (*q & 0x7ff0) >> 4) == 0 ) { if( u.y == 0.0 ) { return( 0.0 ); } /* Input is denormal. */ if( pw2 > 0 ) { u.y *= 2.0; pw2 -= 1; } if( pw2 < 0 ) { if( pw2 < -53 ) return(0.0); u.y /= 2.0; pw2 += 1; } if( pw2 == 0 ) return(u.y); } #endif /* not DEC */ e += pw2; /* Handle overflow */ #ifdef DEC if( e > MEXP ) return( MAXNUM ); #else if( e >= MEXP ) return( 2.0*MAXNUM ); #endif /* Handle denormalized results */ if( e < 1 ) { #ifdef DENORMAL if( e < -53 ) return(0.0); *q &= 0x800f; *q |= 0x10; /* For denormals, significant bits may be lost even when dividing by 2. Construct 2^-(1-e) so the result is obtained with only one multiplication. */ u.y *= md_ldexp(1.0, e-1); return(u.y); #else return(0.0); #endif } else { #ifdef DEC *q &= 0x807f; /* strip all exponent bits */ *q |= (e & 0xff) << 7; #else *q &= 0x800f; *q |= (e & 0x7ff) << 4; #endif return(u.y); } } Math-Cephes-0.5306/libmd/psi.c0000644000175000017500000000731714757021403015632 0ustar shlomifshlomif/* psi.c * * Psi (digamma) function * * * SYNOPSIS: * * double x, y, psi(); * * y = psi( x ); * * * DESCRIPTION: * * d - * psi(x) = -- ln | (x) * dx * * is the logarithmic derivative of the md_gamma function. * For integer x, * n-1 * - * psi(n) = -EUL + > 1/k. * - * k=1 * * This formula is used for 0 < n <= 10. If x is negative, it * is transformed to a positive argument by the reflection * formula psi(1-x) = psi(x) + pi cot(pi x). * For general positive x, the argument is made greater than 10 * using the recurrence psi(x+1) = psi(x) + 1/x. * Then the following asymptotic expansion is applied: * * inf. B * - 2k * psi(x) = md_log(x) - 1/2x - > ------- * - 2k * k=1 2k x * * where the B2k are Bernoulli numbers. * * ACCURACY: * Relative error (except absolute when |psi| < 1): * arithmetic domain # trials peak rms * DEC 0,30 2500 1.7e-16 2.0e-17 * IEEE 0,30 30000 1.3e-15 1.4e-16 * IEEE -30,0 40000 1.5e-15 2.2e-16 * * ERROR MESSAGES: * message condition value returned * psi singularity x integer <=0 MAXNUM */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1992, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double A[] = { 8.33333333333333333333E-2, -2.10927960927960927961E-2, 7.57575757575757575758E-3, -4.16666666666666666667E-3, 3.96825396825396825397E-3, -8.33333333333333333333E-3, 8.33333333333333333333E-2 }; #endif #ifdef DEC static unsigned short A[] = { 0037252,0125252,0125252,0125253, 0136654,0145314,0126312,0146255, 0036370,0037017,0101740,0174076, 0136210,0104210,0104210,0104211, 0036202,0004040,0101010,0020202, 0136410,0104210,0104210,0104211, 0037252,0125252,0125252,0125253 }; #endif #ifdef IBMPC static unsigned short A[] = { 0x5555,0x5555,0x5555,0x3fb5, 0x5996,0x9599,0x9959,0xbf95, 0x1f08,0xf07c,0x07c1,0x3f7f, 0x1111,0x1111,0x1111,0xbf71, 0x0410,0x1041,0x4104,0x3f70, 0x1111,0x1111,0x1111,0xbf81, 0x5555,0x5555,0x5555,0x3fb5 }; #endif #ifdef MIEEE static unsigned short A[] = { 0x3fb5,0x5555,0x5555,0x5555, 0xbf95,0x9959,0x9599,0x5996, 0x3f7f,0x07c1,0xf07c,0x1f08, 0xbf71,0x1111,0x1111,0x1111, 0x3f70,0x4104,0x1041,0x0410, 0xbf81,0x1111,0x1111,0x1111, 0x3fb5,0x5555,0x5555,0x5555 }; #endif #define EUL 0.57721566490153286061 #ifdef ANSIPROT extern double md_floor ( double ); extern double md_log ( double ); extern double md_tan ( double ); extern double polevl ( double, void *, int ); #else double md_floor(), md_log(), md_tan(), polevl(); #endif extern double PI, MAXNUM; double psi(x) double x; { double p, q, nz, s, w, y, z; int i, n, negative; negative = 0; nz = 0.0; if( x <= 0.0 ) { negative = 1; q = x; p = md_floor(q); if( p == q ) { mtherr( "psi", SING ); return( MAXNUM ); } /* Remove the zeros of md_tan(PI x) * by subtracting the nearest integer from x */ nz = q - p; if( nz != 0.5 ) { if( nz > 0.5 ) { p += 1.0; nz = q - p; } nz = PI/md_tan(PI*nz); } else { nz = 0.0; } x = 1.0 - x; } /* check for positive integer up to 10 */ if( (x <= 10.0) && (x == md_floor(x)) ) { y = 0.0; n = x; for( i=1; i 0.59375) { y = b * b; h = y * y; /* Right tail. */ y = planckc (w, T); /* pi^4 / 15 */ y = 6.493939402266829149096 * planck_c1 * h - y; return y; } h = md_exp(-planck_c2/(w*T)); y = 6. * polylog (4, h) * bw; y = (y + 6. * polylog (3, h)) * bw; y = (y + 3. * polylog (2, h)) * bw; y = (y - md_log1p (-h)) * bw; h = w * w; h = h * h; y = y * (planck_c1 / h); return y; } /* planckc * * Complemented Planck radiation integral * * * * SYNOPSIS: * * double lambda, T, y, planckc(); * * y = planckc( lambda, T ); * * * * DESCRIPTION: * * Integral from w to infinity (area under right hand tail) * of Planck's radiation formula. * * The program for large lambda uses an asymptotic series in inverse * powers of the wavelength. * * ACCURACY: * * Relative error. * The domain refers to lambda T / c2. * arithmetic domain # trials peak rms * IEEE 0.6, 10 50000 1.1e-15 2.2e-16 * */ double planckc (w, T) double w; double T; { double b, d, p, u, y; b = T / planck_c2; d = b*w; if (d <= 0.59375) { y = 6.493939402266829149096 * planck_c1 * b*b*b*b; return (y - plancki(w,T)); } u = 1.0/d; p = u * u; #if 0 y = 236364091.*p/365866013534056632601804800000.; y = (y - 15458917./475677107995483570176000000.)*p; y = (y + 174611./123104841613737984000000.)*p; y = (y - 43867./643745871363538944000.)*p; y = ((y + 3617./1081289781411840000.)*p - 1./5928123801600.)*p; y = ((y + 691./78460462080000.)*p - 1./2075673600.)*p; y = ((((y + 1./35481600.)*p - 1.0/544320.)*p + 1.0/6720.)*p - 1./40.)*p; y = y + md_log(d * expm1(u)); y = y - 5.*u/8. + 1./3.; #else y = -236364091.*p/45733251691757079075225600000.; y = (y + 77683./352527500984795136000000.)*p; y = (y - 174611./18465726242060697600000.)*p; y = (y + 43867./107290978560589824000.)*p; y = ((y - 3617./202741834014720000.)*p + 1./1270312243200.)*p; y = ((y - 691./19615115520000.)*p + 1./622702080.)*p; y = ((((y - 1./13305600.)*p + 1./272160.)*p - 1./5040.)*p + 1./60.)*p; y = y - 0.125*u + 1./3.; #endif y = y * planck_c1 * b / (w*w*w); return y; } /* planckd * * Planck's black body radiation formula * * * * SYNOPSIS: * * double lambda, T, y, planckd(); * * y = planckd( lambda, T ); * * * * DESCRIPTION: * * Evaluates Planck's radiation formula * -5 * c1 lambda * E = ------------------ * c2/(lambda T) * e - 1 * */ double planckd(w, T) double w, T; { return (planck_c2 / ((w*w*w*w*w) * (md_exp(planck_c2/(w*T)) - 1.0))); } /* Wavelength, w, of maximum radiation at given temperature T. c2/wT = constant Wein displacement law. */ double planckw(T) double T; { return (planck_c2 / (4.96511423174427630 * T)); } Math-Cephes-0.5306/libmd/gdtr.c0000644000175000017500000000365014757021403015773 0ustar shlomifshlomif/* gdtr.c * * Gamma distribution function * * * * SYNOPSIS: * * double a, b, x, y, gdtr(); * * y = gdtr( a, b, x ); * * * * DESCRIPTION: * * Returns the integral from zero to x of the md_gamma probability * density function: * * * x * b - * a | | b-1 -at * y = ----- | t e dt * - | | * | (b) - * 0 * * The incomplete md_gamma integral is used, according to the * relation * * y = igam( b, ax ). * * * ACCURACY: * * See igam(). * * ERROR MESSAGES: * * message condition value returned * gdtr domain x < 0 0.0 * */ /* gdtrc.c * * Complemented md_gamma distribution function * * * * SYNOPSIS: * * double a, b, x, y, gdtrc(); * * y = gdtrc( a, b, x ); * * * * DESCRIPTION: * * Returns the integral from x to infinity of the md_gamma * probability density function: * * * inf. * b - * a | | b-1 -at * y = ----- | t e dt * - | | * | (b) - * x * * The incomplete md_gamma integral is used, according to the * relation * * y = igamc( b, ax ). * * * ACCURACY: * * See igamc(). * * ERROR MESSAGES: * * message condition value returned * gdtrc domain x < 0 0.0 * */ /* gdtr() */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double igam ( double, double ); extern double igamc ( double, double ); #else double igam(), igamc(); #endif double gdtr( a, b, x ) double a, b, x; { if( x < 0.0 ) { mtherr( "gdtr", DOMAIN ); return( 0.0 ); } return( igam( b, a * x ) ); } double gdtrc( a, b, x ) double a, b, x; { if( x < 0.0 ) { mtherr( "gdtrc", DOMAIN ); return( 0.0 ); } return( igamc( b, a * x ) ); } Math-Cephes-0.5306/libmd/jv.c0000644000175000017500000003605714757021403015461 0ustar shlomifshlomif/* jv.c * * Bessel function of noninteger order * * * * SYNOPSIS: * * double v, x, y, jv(); * * y = jv( v, x ); * * * * DESCRIPTION: * * Returns Bessel function of order v of the argument, * where v is real. Negative x is allowed if v is an integer. * * Several expansions are included: the ascending power * series, the Hankel expansion, and two transitional * expansions for large v. If v is not too large, it * is reduced by recurrence to a region of best accuracy. * The transitional expansions give 12D accuracy for v > 500. * * * * ACCURACY: * Results for integer v are indicated by *, where x and v * both vary from -125 to +125. Otherwise, * x ranges from 0 to 125, v ranges as indicated by "domain." * Error criterion is absolute, except relative when |jv()| > 1. * * arithmetic v domain x domain # trials peak rms * IEEE 0,125 0,125 100000 4.6e-15 2.2e-16 * IEEE -125,0 0,125 40000 5.4e-11 3.7e-13 * IEEE 0,500 0,500 20000 4.4e-15 4.0e-16 * Integer v: * IEEE -125,125 -125,125 50000 3.5e-15* 1.9e-16* * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier */ #include "mconf.h" #define DEBUG 0 #ifdef DEC #define MAXGAM 34.84425627277176174 #else #define MAXGAM 171.624376956302725 #endif #ifdef ANSIPROT extern int airy ( double, double *, double *, double *, double * ); extern double md_fabs ( double ); extern double md_floor ( double ); extern double md_frexp ( double, int * ); extern double polevl ( double, void *, int ); extern double md_j0 ( double ); extern double md_j1 ( double ); extern double sqrt ( double ); extern double md_cbrt ( double ); extern double md_exp ( double ); extern double md_log ( double ); extern double md_sin ( double ); extern double md_cos ( double ); extern double md_acos ( double ); extern double md_pow ( double, double ); extern double md_gamma ( double ); extern double lgam ( double ); static double recur(double *, double, double *, int); static double jvs(double, double); static double hankel(double, double); static double jnx(double, double); static double jnt(double, double); #else int airy(); double md_fabs(), md_floor(), md_frexp(), polevl(), md_j0(), md_j1(), sqrt(), md_cbrt(); double md_exp(), md_log(), md_sin(), md_cos(), md_acos(), md_pow(), md_gamma(), lgam(); static double recur(), jvs(), hankel(), jnx(), jnt(); #endif extern double MAXNUM, MACHEP, MINLOG, MAXLOG; #define BIG 1.44115188075855872E+17 double jv( n, x ) double n, x; { double k, q, t, y, an; int i, sign, nint; nint = 0; /* Flag for integer n */ sign = 1; /* Flag for sign inversion */ an = md_fabs( n ); y = md_floor( an ); if( y == an ) { nint = 1; i = an - 16384.0 * md_floor( an/16384.0 ); if( n < 0.0 ) { if( i & 1 ) sign = -sign; n = an; } if( x < 0.0 ) { if( i & 1 ) sign = -sign; x = -x; } if( n == 0.0 ) return( md_j0(x) ); if( n == 1.0 ) return( sign * md_j1(x) ); } if( (x < 0.0) && (y != an) ) { mtherr( "Jv", DOMAIN ); y = 0.0; goto done; } y = md_fabs(x); if( y < MACHEP ) goto underf; k = 3.6 * sqrt(y); t = 3.6 * sqrt(an); if( (y < t) && (an > 21.0) ) return( sign * jvs(n,x) ); if( (an < k) && (y > 21.0) ) return( sign * hankel(n,x) ); if( an < 500.0 ) { /* Note: if x is too large, the continued * fraction will fail; but then the * Hankel expansion can be used. */ if( nint != 0 ) { k = 0.0; q = recur( &n, x, &k, 1 ); if( k == 0.0 ) { y = md_j0(x)/q; goto done; } if( k == 1.0 ) { y = md_j1(x)/q; goto done; } } if( an > 2.0 * y ) goto rlarger; if( (n >= 0.0) && (n < 20.0) && (y > 6.0) && (y < 20.0) ) { /* Recur backwards from a larger value of n */ rlarger: k = n; y = y + an + 1.0; if( y < 30.0 ) y = 30.0; y = n + md_floor(y-n); q = recur( &y, x, &k, 0 ); y = jvs(y,x) * q; goto done; } if( k <= 30.0 ) { k = 2.0; } else if( k < 90.0 ) { k = (3*k)/4; } if( an > (k + 3.0) ) { if( n < 0.0 ) k = -k; q = n - md_floor(n); k = md_floor(k) + q; if( n > 0.0 ) q = recur( &n, x, &k, 1 ); else { t = k; k = n; q = recur( &t, x, &k, 1 ); k = t; } if( q == 0.0 ) { underf: y = 0.0; goto done; } } else { k = n; q = 1.0; } /* boundary between convergence of * power series and Hankel expansion */ y = md_fabs(k); if( y < 26.0 ) t = (0.0083*y + 0.09)*y + 12.9; else t = 0.9 * y; if( x > t ) y = hankel(k,x); else y = jvs(k,x); #if DEBUG printf( "y = %.16e, recur q = %.16e\n", y, q ); #endif if( n > 0.0 ) y /= q; else y *= q; } else { /* For large n, use the uniform expansion * or the transitional expansion. * But if x is of the order of n**2, * these may blow up, whereas the * Hankel expansion will then work. */ if( n < 0.0 ) { mtherr( "Jv", TLOSS ); y = 0.0; goto done; } t = x/n; t /= n; if( t > 0.3 ) y = hankel(n,x); else y = jnx(n,x); } done: return( sign * y); } /* Reduce the order by backward recurrence. * AMS55 #9.1.27 and 9.1.73. */ static double recur( n, x, newn, cancel ) double *n; double x; double *newn; int cancel; { double pkm2, pkm1, pk, qkm2, qkm1; /* double pkp1; */ double k, ans, qk, xk, yk, r, t, kf; static double big = BIG; int nflag, ctr; /* continued fraction for Jn(x)/Jn-1(x) */ if( *n < 0.0 ) nflag = 1; else nflag = 0; fstart: #if DEBUG printf( "recur: n = %.6e, newn = %.6e, cfrac = ", *n, *newn ); #endif pkm2 = 0.0; qkm2 = 1.0; pkm1 = x; qkm1 = *n + *n; xk = -x * x; yk = qkm1; ans = 1.0; ctr = 0; do { yk += 2.0; pk = pkm1 * yk + pkm2 * xk; qk = qkm1 * yk + qkm2 * xk; pkm2 = pkm1; pkm1 = pk; qkm2 = qkm1; qkm1 = qk; if( qk != 0 ) r = pk/qk; else r = 0.0; if( r != 0 ) { t = md_fabs( (ans - r)/r ); ans = r; } else t = 1.0; if( ++ctr > 1000 ) { mtherr( "jv", UNDERFLOW ); goto done; } if( t < MACHEP ) goto done; if( md_fabs(pk) > big ) { pkm2 /= big; pkm1 /= big; qkm2 /= big; qkm1 /= big; } } while( t > MACHEP ); done: #if DEBUG printf( "%.6e\n", ans ); #endif /* Change n to n-1 if n < 0 and the continued fraction is small */ if( nflag > 0 ) { if( md_fabs(ans) < 0.125 ) { nflag = -1; *n = *n - 1.0; goto fstart; } } kf = *newn; /* backward recurrence * 2k * J (x) = --- J (x) - J (x) * k-1 x k k+1 */ pk = 1.0; pkm1 = 1.0/ans; k = *n - 1.0; r = 2 * k; do { pkm2 = (pkm1 * r - pk * x) / x; /* pkp1 = pk; */ pk = pkm1; pkm1 = pkm2; r -= 2.0; /* t = md_fabs(pkp1) + md_fabs(pk); if( (k > (kf + 2.5)) && (md_fabs(pkm1) < 0.25*t) ) { k -= 1.0; t = x*x; pkm2 = ( (r*(r+2.0)-t)*pk - r*x*pkp1 )/t; pkp1 = pk; pk = pkm1; pkm1 = pkm2; r -= 2.0; } */ k -= 1.0; } while( k > (kf + 0.5) ); /* Take the larger of the last two iterates * on the theory that it may have less cancellation error. */ if( cancel ) { if( (kf >= 0.0) && (md_fabs(pk) > md_fabs(pkm1)) ) { k += 1.0; pkm2 = pk; } } *newn = k; #if DEBUG printf( "newn %.6e rans %.6e\n", k, pkm2 ); #endif return( pkm2 ); } /* Ascending power series for Jv(x). * AMS55 #9.1.10. */ extern double PI; extern int sgngam; static double jvs( n, x ) double n, x; { double t, u, y, z, k; int ex; z = -x * x / 4.0; u = 1.0; y = u; k = 1.0; t = 1.0; while( t > MACHEP ) { u *= z / (k * (n+k)); y += u; k += 1.0; if( y != 0 ) t = md_fabs( u/y ); } #if DEBUG printf( "power series=%.5e ", y ); #endif t = md_frexp( 0.5*x, &ex ); ex = ex * n; if( (ex > -1023) && (ex < 1023) && (n > 0.0) && (n < (MAXGAM-1.0)) ) { t = md_pow( 0.5*x, n ) / md_gamma( n + 1.0 ); #if DEBUG printf( "md_pow(.5*x, %.4e)/md_gamma(n+1)=%.5e\n", n, t ); #endif y *= t; } else { #if DEBUG z = n * md_log(0.5*x); k = lgam( n+1.0 ); t = z - k; printf( "md_log md_pow=%.5e, lgam(%.4e)=%.5e\n", z, n+1.0, k ); #else t = n * md_log(0.5*x) - lgam(n + 1.0); #endif if( y < 0 ) { sgngam = -sgngam; y = -y; } t += md_log(y); #if DEBUG printf( "md_log y=%.5e\n", md_log(y) ); #endif if( t < -MAXLOG ) { return( 0.0 ); } if( t > MAXLOG ) { mtherr( "Jv", OVERFLOW ); return( MAXNUM ); } y = sgngam * md_exp( t ); } return(y); } /* Hankel's asymptotic expansion * for large x. * AMS55 #9.2.5. */ static double hankel( n, x ) double n, x; { double t, u, z, k, sign, conv; double p, q, j, m, pp, qq; int flag; m = 4.0*n*n; j = 1.0; z = 8.0 * x; k = 1.0; p = 1.0; u = (m - 1.0)/z; q = u; sign = 1.0; conv = 1.0; flag = 0; t = 1.0; pp = 1.0e38; qq = 1.0e38; while( t > MACHEP ) { k += 2.0; j += 1.0; sign = -sign; u *= (m - k * k)/(j * z); p += sign * u; k += 2.0; j += 1.0; u *= (m - k * k)/(j * z); q += sign * u; t = md_fabs(u/p); if( t < conv ) { conv = t; qq = q; pp = p; flag = 1; } /* stop if the terms start getting larger */ if( (flag != 0) && (t > conv) ) { #if DEBUG printf( "Hankel: convergence to %.4E\n", conv ); #endif goto hank1; } } hank1: u = x - (0.5*n + 0.25) * PI; t = sqrt( 2.0/(PI*x) ) * ( pp * md_cos(u) - qq * md_sin(u) ); #if DEBUG printf( "hank: %.6e\n", t ); #endif return( t ); } /* Asymptotic expansion for large n. * AMS55 #9.3.35. */ static double lambda[] = { 1.0, 1.041666666666666666666667E-1, 8.355034722222222222222222E-2, 1.282265745563271604938272E-1, 2.918490264641404642489712E-1, 8.816272674437576524187671E-1, 3.321408281862767544702647E+0, 1.499576298686255465867237E+1, 7.892301301158651813848139E+1, 4.744515388682643231611949E+2, 3.207490090890661934704328E+3 }; static double mu[] = { 1.0, -1.458333333333333333333333E-1, -9.874131944444444444444444E-2, -1.433120539158950617283951E-1, -3.172272026784135480967078E-1, -9.424291479571202491373028E-1, -3.511203040826354261542798E+0, -1.572726362036804512982712E+1, -8.228143909718594444224656E+1, -4.923553705236705240352022E+2, -3.316218568547972508762102E+3 }; static double P1[] = { -2.083333333333333333333333E-1, 1.250000000000000000000000E-1 }; static double P2[] = { 3.342013888888888888888889E-1, -4.010416666666666666666667E-1, 7.031250000000000000000000E-2 }; static double P3[] = { -1.025812596450617283950617E+0, 1.846462673611111111111111E+0, -8.912109375000000000000000E-1, 7.324218750000000000000000E-2 }; static double P4[] = { 4.669584423426247427983539E+0, -1.120700261622299382716049E+1, 8.789123535156250000000000E+0, -2.364086914062500000000000E+0, 1.121520996093750000000000E-1 }; static double P5[] = { -2.8212072558200244877E1, 8.4636217674600734632E1, -9.1818241543240017361E1, 4.2534998745388454861E1, -7.3687943594796316964E0, 2.27108001708984375E-1 }; static double P6[] = { 2.1257013003921712286E2, -7.6525246814118164230E2, 1.0599904525279998779E3, -6.9957962737613254123E2, 2.1819051174421159048E2, -2.6491430486951555525E1, 5.7250142097473144531E-1 }; static double P7[] = { -1.9194576623184069963E3, 8.0617221817373093845E3, -1.3586550006434137439E4, 1.1655393336864533248E4, -5.3056469786134031084E3, 1.2009029132163524628E3, -1.0809091978839465550E2, 1.7277275025844573975E0 }; static double jnx( n, x ) double n, x; { double zeta, sqz, zz, zp, np; double cbn, n23, t, z, sz; double pp, qq, z32i, zzi; double ak, bk, akl, bkl; int sign, doa, dob, nflg, k, s, tk, tkp1, m; static double u[8]; static double ai, aip, bi, bip; /* Test for x very close to n. * Use expansion for transition region if so. */ cbn = md_cbrt(n); z = (x - n)/cbn; if( md_fabs(z) <= 0.7 ) return( jnt(n,x) ); z = x/n; zz = 1.0 - z*z; if( zz == 0.0 ) return(0.0); if( zz > 0.0 ) { sz = sqrt( zz ); t = 1.5 * (md_log( (1.0+sz)/z ) - sz ); /* zeta ** 3/2 */ zeta = md_cbrt( t * t ); nflg = 1; } else { sz = sqrt(-zz); t = 1.5 * (sz - md_acos(1.0/z)); zeta = -md_cbrt( t * t ); nflg = -1; } z32i = md_fabs(1.0/t); sqz = md_cbrt(t); /* Airy function */ n23 = md_cbrt( n * n ); t = n23 * zeta; #if DEBUG printf("zeta %.5E, Airy(%.5E)\n", zeta, t ); #endif airy( t, &ai, &aip, &bi, &bip ); /* polynomials in expansion */ u[0] = 1.0; zzi = 1.0/zz; u[1] = polevl( zzi, P1, 1 )/sz; u[2] = polevl( zzi, P2, 2 )/zz; u[3] = polevl( zzi, P3, 3 )/(sz*zz); pp = zz*zz; u[4] = polevl( zzi, P4, 4 )/pp; u[5] = polevl( zzi, P5, 5 )/(pp*sz); pp *= zz; u[6] = polevl( zzi, P6, 6 )/pp; u[7] = polevl( zzi, P7, 7 )/(pp*sz); #if DEBUG for( k=0; k<=7; k++ ) printf( "u[%d] = %.5E\n", k, u[k] ); #endif pp = 0.0; qq = 0.0; np = 1.0; /* flags to stop when terms get larger */ doa = 1; dob = 1; akl = MAXNUM; bkl = MAXNUM; for( k=0; k<=3; k++ ) { tk = 2 * k; tkp1 = tk + 1; zp = 1.0; ak = 0.0; bk = 0.0; for( s=0; s<=tk; s++ ) { if( doa ) { if( (s & 3) > 1 ) sign = nflg; else sign = 1; ak += sign * mu[s] * zp * u[tk-s]; } if( dob ) { m = tkp1 - s; if( ((m+1) & 3) > 1 ) sign = nflg; else sign = 1; bk += sign * lambda[s] * zp * u[m]; } zp *= z32i; } if( doa ) { ak *= np; t = md_fabs(ak); if( t < akl ) { akl = t; pp += ak; } else doa = 0; } if( dob ) { bk += lambda[tkp1] * zp * u[0]; bk *= -np/sqz; t = md_fabs(bk); if( t < bkl ) { bkl = t; qq += bk; } else dob = 0; } #if DEBUG printf("a[%d] %.5E, b[%d] %.5E\n", k, ak, k, bk ); #endif if( np < MACHEP ) break; np /= n*n; } /* normalizing factor ( 4*zeta/(1 - z**2) )**1/4 */ t = 4.0 * zeta/zz; t = sqrt( sqrt(t) ); t *= ai*pp/md_cbrt(n) + aip*qq/(n23*n); return(t); } /* Asymptotic expansion for transition region, * n large and x close to n. * AMS55 #9.3.23. */ static double PF2[] = { -9.0000000000000000000e-2, 8.5714285714285714286e-2 }; static double PF3[] = { 1.3671428571428571429e-1, -5.4920634920634920635e-2, -4.4444444444444444444e-3 }; static double PF4[] = { 1.3500000000000000000e-3, -1.6036054421768707483e-1, 4.2590187590187590188e-2, 2.7330447330447330447e-3 }; static double PG1[] = { -2.4285714285714285714e-1, 1.4285714285714285714e-2 }; static double PG2[] = { -9.0000000000000000000e-3, 1.9396825396825396825e-1, -1.1746031746031746032e-2 }; static double PG3[] = { 1.9607142857142857143e-2, -1.5983694083694083694e-1, 6.3838383838383838384e-3 }; static double jnt( n, x ) double n, x; { double z, zz, z3; double cbn, n23, cbtwo; double ai, aip, bi, bip; /* Airy functions */ double nk, fk, gk, pp, qq; double F[5], G[4]; int k; cbn = md_cbrt(n); z = (x - n)/cbn; cbtwo = md_cbrt( 2.0 ); /* Airy function */ zz = -cbtwo * z; airy( zz, &ai, &aip, &bi, &bip ); /* polynomials in expansion */ zz = z * z; z3 = zz * z; F[0] = 1.0; F[1] = -z/5.0; F[2] = polevl( z3, PF2, 1 ) * zz; F[3] = polevl( z3, PF3, 2 ); F[4] = polevl( z3, PF4, 3 ) * z; G[0] = 0.3 * zz; G[1] = polevl( z3, PG1, 1 ); G[2] = polevl( z3, PG2, 2 ) * z; G[3] = polevl( z3, PG3, 2 ) * zz; #if DEBUG for( k=0; k<=4; k++ ) printf( "F[%d] = %.5E\n", k, F[k] ); for( k=0; k<=3; k++ ) printf( "G[%d] = %.5E\n", k, G[k] ); #endif pp = 0.0; qq = 0.0; nk = 1.0; n23 = md_cbrt( n * n ); for( k=0; k<=4; k++ ) { fk = F[k]*nk; pp += fk; if( k != 4 ) { gk = G[k]*nk; qq += gk; } #if DEBUG printf("fk[%d] %.5E, gk[%d] %.5E\n", k, fk, k, gk ); #endif nk /= n23; } fk = cbtwo * ai * pp/cbn + md_cbrt(4.0) * aip * qq/n; return(fk); } Math-Cephes-0.5306/libmd/asinh.c0000644000175000017500000000577614757021403016150 0ustar shlomifshlomif/* md_asinh.c * * Inverse hyperbolic sine * * * * SYNOPSIS: * * double x, y, md_asinh(); * * y = md_asinh( x ); * * * * DESCRIPTION: * * Returns inverse hyperbolic sine of argument. * * If |x| < 0.5, the function is approximated by a rational * form x + x**3 P(x)/Q(x). Otherwise, * * md_asinh(x) = md_log( x + sqrt(1 + x*x) ). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -3,3 75000 4.6e-17 1.1e-17 * IEEE -1,1 30000 3.7e-16 7.8e-17 * IEEE 1,3 30000 2.5e-16 6.7e-17 * */ /* md_asinh.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double P[] = { -4.33231683752342103572E-3, -5.91750212056387121207E-1, -4.37390226194356683570E0, -9.09030533308377316566E0, -5.56682227230859640450E0 }; static double Q[] = { /* 1.00000000000000000000E0,*/ 1.28757002067426453537E1, 4.86042483805291788324E1, 6.95722521337257608734E1, 3.34009336338516356383E1 }; #endif #ifdef DEC static unsigned short P[] = { 0136215,0173033,0110410,0105475, 0140027,0076361,0020056,0164520, 0140613,0173401,0160136,0053142, 0141021,0070744,0000503,0176261, 0140662,0021550,0073106,0133351 }; static unsigned short Q[] = { /* 0040200,0000000,0000000,0000000,*/ 0041116,0001336,0034120,0173054, 0041502,0065300,0013144,0021231, 0041613,0022376,0035516,0153063, 0041405,0115216,0054265,0004557 }; #endif #ifdef IBMPC static unsigned short P[] = { 0x1168,0x7221,0xbec3,0xbf71, 0xdd2a,0x2405,0xef9e,0xbfe2, 0xcacc,0x3c0b,0x7ee0,0xc011, 0x7f96,0x8028,0x2e3c,0xc022, 0xd6dd,0x0ec8,0x446d,0xc016 }; static unsigned short Q[] = { /* 0x0000,0x0000,0x0000,0x3ff0,*/ 0x1ec5,0xc70a,0xc05b,0x4029, 0x8453,0x02cc,0x4d58,0x4048, 0xdac6,0xc769,0x649f,0x4051, 0xa12e,0xcb16,0xb351,0x4040 }; #endif #ifdef MIEEE static unsigned short P[] = { 0xbf71,0xbec3,0x7221,0x1168, 0xbfe2,0xef9e,0x2405,0xdd2a, 0xc011,0x7ee0,0x3c0b,0xcacc, 0xc022,0x2e3c,0x8028,0x7f96, 0xc016,0x446d,0x0ec8,0xd6dd }; static unsigned short Q[] = { 0x4029,0xc05b,0xc70a,0x1ec5, 0x4048,0x4d58,0x02cc,0x8453, 0x4051,0x649f,0xc769,0xdac6, 0x4040,0xb351,0xcb16,0xa12e }; #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double sqrt ( double ); extern double md_log ( double ); #else double md_log(), sqrt(), polevl(), p1evl(); #endif extern double LOGE2, INFINITY; double md_asinh(xx) double xx; { double a, z, x; int sign; #ifdef MINUSZERO if( xx == 0.0 ) return(xx); #endif if( xx < 0.0 ) { sign = -1; x = -xx; } else { sign = 1; x = xx; } if( x > 1.0e8 ) { #ifdef INFINITIES if( x == INFINITY ) return(xx); #endif return( sign * (md_log(x) + LOGE2) ); } z = x * x; if( x < 0.5 ) { a = ( polevl(z, P, 4)/p1evl(z, Q, 4) ) * z; a = a * x + x; if( sign < 0 ) a = -a; return(a); } a = sqrt( z + 1.0 ); return( sign * md_log(x + a) ); } Math-Cephes-0.5306/libmd/exp.c0000644000175000017500000001100214757021403015615 0ustar shlomifshlomif/* md_exp.c * * Exponential function * * * * SYNOPSIS: * * double x, y, md_exp(); * * y = md_exp( x ); * * * * DESCRIPTION: * * Returns e (2.71828...) raised to the x power. * * Range reduction is accomplished by separating the argument * into an integer k and fraction f such that * * x k f * e = 2 e. * * A Pade' form 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) * of degree 2/3 is used to approximate md_exp(f) in the basic * interval [-0.5, 0.5]. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC +- 88 50000 2.8e-17 7.0e-18 * IEEE +- 708 40000 2.0e-16 5.6e-17 * * * Error amplification in the exponential function can be * a serious matter. The error propagation involves * md_exp( X(1+delta) ) = md_exp(X) ( 1 + X*delta + ... ), * which shows that a 1 lsb error in representing X produces * a relative error of X times 1 lsb in the function. * While the routine gives an accurate result for arguments * that are exactly represented by a double precision * computer number, the result contains amplified roundoff * error for large arguments not exactly represented. * * * ERROR MESSAGES: * * message condition value returned * md_exp underflow x < MINLOG 0.0 * md_exp overflow x > MAXLOG INFINITY * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ /* Exponential function */ #include "mconf.h" #ifdef UNK static double P[] = { 1.26177193074810590878E-4, 3.02994407707441961300E-2, 9.99999999999999999910E-1, }; static double Q[] = { 3.00198505138664455042E-6, 2.52448340349684104192E-3, 2.27265548208155028766E-1, 2.00000000000000000009E0, }; static double C1 = 6.93145751953125E-1; static double C2 = 1.42860682030941723212E-6; #endif #ifdef DEC static unsigned short P[] = { 0035004,0047156,0127442,0057502, 0036770,0033210,0063121,0061764, 0040200,0000000,0000000,0000000, }; static unsigned short Q[] = { 0033511,0072665,0160662,0176377, 0036045,0070715,0124105,0132777, 0037550,0134114,0142077,0001637, 0040400,0000000,0000000,0000000, }; static unsigned short sc1[] = {0040061,0071000,0000000,0000000}; #define C1 (*(double *)sc1) static unsigned short sc2[] = {0033277,0137216,0075715,0057117}; #define C2 (*(double *)sc2) #endif #ifdef IBMPC static unsigned short P[] = { 0x4be8,0xd5e4,0x89cd,0x3f20, 0x2c7e,0x0cca,0x06d1,0x3f9f, 0x0000,0x0000,0x0000,0x3ff0, }; static unsigned short Q[] = { 0x5fa0,0xbc36,0x2eb6,0x3ec9, 0xb6c0,0xb508,0xae39,0x3f64, 0xe074,0x9887,0x1709,0x3fcd, 0x0000,0x0000,0x0000,0x4000, }; static unsigned short sc1[] = {0x0000,0x0000,0x2e40,0x3fe6}; #define C1 (*(double *)sc1) static unsigned short sc2[] = {0xabca,0xcf79,0xf7d1,0x3eb7}; #define C2 (*(double *)sc2) #endif #ifdef MIEEE static unsigned short P[] = { 0x3f20,0x89cd,0xd5e4,0x4be8, 0x3f9f,0x06d1,0x0cca,0x2c7e, 0x3ff0,0x0000,0x0000,0x0000, }; static unsigned short Q[] = { 0x3ec9,0x2eb6,0xbc36,0x5fa0, 0x3f64,0xae39,0xb508,0xb6c0, 0x3fcd,0x1709,0x9887,0xe074, 0x4000,0x0000,0x0000,0x0000, }; static unsigned short sc1[] = {0x3fe6,0x2e40,0x0000,0x0000}; #define C1 (*(double *)sc1) static unsigned short sc2[] = {0x3eb7,0xf7d1,0xcf79,0xabca}; #define C2 (*(double *)sc2) #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_floor ( double ); extern double md_ldexp ( double, int ); extern int isnan ( double ); extern int isfinite ( double ); #else double polevl(), p1evl(), md_floor(), md_ldexp(); int isnan(), isfinite(); #endif extern double LOGE2, LOG2E, MAXLOG, MINLOG, MAXNUM; #ifdef INFINITIES extern double INFINITY; #endif double md_exp(x) double x; { double px, xx; int n; #ifdef NANS if( isnan(x) ) return(x); #endif if( x > MAXLOG) { #ifdef INFINITIES return( INFINITY ); #else mtherr( "md_exp", OVERFLOW ); return( MAXNUM ); #endif } if( x < MINLOG ) { #ifndef INFINITIES mtherr( "md_exp", UNDERFLOW ); #endif return(0.0); } /* Express e**x = e**g 2**n * = e**g e**( n loge(2) ) * = e**( g + n loge(2) ) */ px = md_floor( LOG2E * x + 0.5 ); /* md_floor() truncates toward -infinity. */ n = px; x -= px * C1; x -= px * C2; /* rational approximation for exponential * of the fractional part: * e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) */ xx = x * x; px = x * polevl( xx, P, 2 ); x = px/( polevl( xx, Q, 3 ) - px ); x = 1.0 + 2.0 * x; /* multiply by power of 2 */ x = md_ldexp( x, n ); return(x); } Math-Cephes-0.5306/libmd/zetac.c0000644000175000017500000003350314757021403016141 0ustar shlomifshlomif /* zetac.c * * Riemann zeta function * * * * SYNOPSIS: * * double x, y, zetac(); * * y = zetac( x ); * * * * DESCRIPTION: * * * * inf. * - -x * zetac(x) = > k , x > 1, * - * k=2 * * is related to the Riemann zeta function by * * Riemann zeta(x) = zetac(x) + 1. * * Extension of the function definition for x < 1 is implemented. * Zero is returned for x > md_log2(MAXNUM). * * An overflow error may occur for large negative x, due to the * md_gamma function in the reflection formula. * * ACCURACY: * * Tabulated values have full machine accuracy. * * Relative error: * arithmetic domain # trials peak rms * IEEE 1,50 10000 9.8e-16 1.3e-16 * DEC 1,50 2000 1.1e-16 1.9e-17 * * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier */ #include "mconf.h" extern double MAXNUM, PI; /* Riemann zeta(x) - 1 * for integer arguments between 0 and 30. */ #ifdef UNK static double azetac[] = { -1.50000000000000000000E0, 1.70141183460469231730E38, /* infinity. */ 6.44934066848226436472E-1, 2.02056903159594285400E-1, 8.23232337111381915160E-2, 3.69277551433699263314E-2, 1.73430619844491397145E-2, 8.34927738192282683980E-3, 4.07735619794433937869E-3, 2.00839282608221441785E-3, 9.94575127818085337146E-4, 4.94188604119464558702E-4, 2.46086553308048298638E-4, 1.22713347578489146752E-4, 6.12481350587048292585E-5, 3.05882363070204935517E-5, 1.52822594086518717326E-5, 7.63719763789976227360E-6, 3.81729326499983985646E-6, 1.90821271655393892566E-6, 9.53962033872796113152E-7, 4.76932986787806463117E-7, 2.38450502727732990004E-7, 1.19219925965311073068E-7, 5.96081890512594796124E-8, 2.98035035146522801861E-8, 1.49015548283650412347E-8, 7.45071178983542949198E-9, 3.72533402478845705482E-9, 1.86265972351304900640E-9, 9.31327432419668182872E-10 }; #endif #ifdef DEC static unsigned short azetac[] = { 0140300,0000000,0000000,0000000, 0077777,0177777,0177777,0177777, 0040045,0015146,0022460,0076462, 0037516,0164001,0036001,0104116, 0037250,0114425,0061754,0022033, 0037027,0040616,0145174,0146670, 0036616,0011411,0100444,0104437, 0036410,0145550,0051474,0161067, 0036205,0115527,0141434,0133506, 0036003,0117475,0100553,0053403, 0035602,0056147,0045567,0027703, 0035401,0106157,0111054,0145242, 0035201,0002455,0113151,0101015, 0035000,0126235,0004273,0157260, 0034600,0071127,0112647,0005261, 0034400,0045736,0057610,0157550, 0034200,0031146,0172621,0074172, 0034000,0020603,0115503,0032007, 0033600,0013114,0124672,0023135, 0033400,0007330,0043715,0151117, 0033200,0004742,0145043,0033514, 0033000,0003225,0152624,0004411, 0032600,0002143,0033166,0035746, 0032400,0001354,0074234,0026143, 0032200,0000762,0147776,0170220, 0032000,0000514,0072452,0130631, 0031600,0000335,0114266,0063315, 0031400,0000223,0132710,0041045, 0031200,0000142,0073202,0153426, 0031000,0000101,0121400,0152065, 0030600,0000053,0140525,0072761 }; #endif #ifdef IBMPC static unsigned short azetac[] = { 0x0000,0x0000,0x0000,0xbff8, 0xffff,0xffff,0xffff,0x7fef, 0x0fa6,0xc4a6,0xa34c,0x3fe4, 0x310a,0x2780,0xdd00,0x3fc9, 0x8483,0xac7d,0x1322,0x3fb5, 0x99b7,0xd94f,0xe831,0x3fa2, 0x9124,0x3024,0xc261,0x3f91, 0x9c47,0x0a67,0x196d,0x3f81, 0x96e9,0xf863,0xb36a,0x3f70, 0x6ae0,0xb02d,0x73e7,0x3f60, 0xe5f8,0xe96e,0x4b8c,0x3f50, 0x9954,0xf245,0x318d,0x3f40, 0x3042,0xb2cd,0x20a5,0x3f30, 0x7bd6,0xa117,0x1593,0x3f20, 0xe156,0xf2b4,0x0e4a,0x3f10, 0x1bed,0xcbf1,0x097b,0x3f00, 0x2f0f,0xdeb2,0x064c,0x3ef0, 0x6681,0x7368,0x0430,0x3ee0, 0x44cc,0x9537,0x02c9,0x3ed0, 0xba4a,0x08f9,0x01db,0x3ec0, 0x66ea,0x5944,0x013c,0x3eb0, 0x8121,0xbab2,0x00d2,0x3ea0, 0xc77d,0x66ce,0x008c,0x3e90, 0x858c,0x8f13,0x005d,0x3e80, 0xde12,0x59ff,0x003e,0x3e70, 0x5633,0x8ea5,0x0029,0x3e60, 0xccda,0xb316,0x001b,0x3e50, 0x0845,0x76b9,0x0012,0x3e40, 0x5ae3,0x4ed0,0x000c,0x3e30, 0x1a87,0x3460,0x0008,0x3e20, 0xaebe,0x782a,0x0005,0x3e10 }; #endif #ifdef MIEEE static unsigned short azetac[] = { 0xbff8,0x0000,0x0000,0x0000, 0x7fef,0xffff,0xffff,0xffff, 0x3fe4,0xa34c,0xc4a6,0x0fa6, 0x3fc9,0xdd00,0x2780,0x310a, 0x3fb5,0x1322,0xac7d,0x8483, 0x3fa2,0xe831,0xd94f,0x99b7, 0x3f91,0xc261,0x3024,0x9124, 0x3f81,0x196d,0x0a67,0x9c47, 0x3f70,0xb36a,0xf863,0x96e9, 0x3f60,0x73e7,0xb02d,0x6ae0, 0x3f50,0x4b8c,0xe96e,0xe5f8, 0x3f40,0x318d,0xf245,0x9954, 0x3f30,0x20a5,0xb2cd,0x3042, 0x3f20,0x1593,0xa117,0x7bd6, 0x3f10,0x0e4a,0xf2b4,0xe156, 0x3f00,0x097b,0xcbf1,0x1bed, 0x3ef0,0x064c,0xdeb2,0x2f0f, 0x3ee0,0x0430,0x7368,0x6681, 0x3ed0,0x02c9,0x9537,0x44cc, 0x3ec0,0x01db,0x08f9,0xba4a, 0x3eb0,0x013c,0x5944,0x66ea, 0x3ea0,0x00d2,0xbab2,0x8121, 0x3e90,0x008c,0x66ce,0xc77d, 0x3e80,0x005d,0x8f13,0x858c, 0x3e70,0x003e,0x59ff,0xde12, 0x3e60,0x0029,0x8ea5,0x5633, 0x3e50,0x001b,0xb316,0xccda, 0x3e40,0x0012,0x76b9,0x0845, 0x3e30,0x000c,0x4ed0,0x5ae3, 0x3e20,0x0008,0x3460,0x1a87, 0x3e10,0x0005,0x782a,0xaebe }; #endif /* 2**x (1 - 1/x) (zeta(x) - 1) = P(1/x)/Q(1/x), 1 <= x <= 10 */ #ifdef UNK static double P[9] = { 5.85746514569725319540E11, 2.57534127756102572888E11, 4.87781159567948256438E10, 5.15399538023885770696E9, 3.41646073514754094281E8, 1.60837006880656492731E7, 5.92785467342109522998E5, 1.51129169964938823117E4, 2.01822444485997955865E2, }; static double Q[8] = { /* 1.00000000000000000000E0,*/ 3.90497676373371157516E11, 5.22858235368272161797E10, 5.64451517271280543351E9, 3.39006746015350418834E8, 1.79410371500126453702E7, 5.66666825131384797029E5, 1.60382976810944131506E4, 1.96436237223387314144E2, }; #endif #ifdef DEC static unsigned short P[36] = { 0052010,0060466,0101211,0134657, 0051557,0154353,0135060,0064411, 0051065,0133157,0133514,0133633, 0050231,0114735,0035036,0111344, 0047242,0164327,0146036,0033545, 0046165,0065364,0130045,0011005, 0045020,0134427,0075073,0134107, 0043554,0021653,0000440,0177426, 0042111,0151213,0134312,0021402, }; static unsigned short Q[32] = { /*0040200,0000000,0000000,0000000,*/ 0051665,0153363,0054252,0137010, 0051102,0143645,0121415,0036107, 0050250,0034073,0131133,0036465, 0047241,0123250,0150037,0070012, 0046210,0160426,0111463,0116507, 0045012,0054255,0031674,0173612, 0043572,0114460,0151520,0012221, 0042104,0067655,0037037,0137421, }; #endif #ifdef IBMPC static unsigned short P[36] = { 0x3736,0xd051,0x0c26,0x4261, 0x0d21,0x7746,0xfb1d,0x424d, 0x96f3,0xf6e9,0xb6cd,0x4226, 0xd25c,0xa743,0x333b,0x41f3, 0xc6ed,0xf983,0x5d1a,0x41b4, 0xa241,0x9604,0xad5e,0x416e, 0x7709,0xef47,0x1722,0x4122, 0x1fe3,0x6024,0x8475,0x40cd, 0x4460,0x7719,0x3a51,0x4069, }; static unsigned short Q[32] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x57c1,0x6b15,0xbade,0x4256, 0xa789,0xb461,0x58f4,0x4228, 0x67a7,0x764b,0x0707,0x41f5, 0xee01,0x1a03,0x34d5,0x41b4, 0x73a9,0xd266,0x1c22,0x4171, 0x9ef1,0xa677,0x4b15,0x4121, 0x0292,0x1a6a,0x5326,0x40cf, 0xf7e2,0xa7c3,0x8df5,0x4068, }; #endif #ifdef MIEEE static unsigned short P[36] = { 0x4261,0x0c26,0xd051,0x3736, 0x424d,0xfb1d,0x7746,0x0d21, 0x4226,0xb6cd,0xf6e9,0x96f3, 0x41f3,0x333b,0xa743,0xd25c, 0x41b4,0x5d1a,0xf983,0xc6ed, 0x416e,0xad5e,0x9604,0xa241, 0x4122,0x1722,0xef47,0x7709, 0x40cd,0x8475,0x6024,0x1fe3, 0x4069,0x3a51,0x7719,0x4460, }; static unsigned short Q[32] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4256,0xbade,0x6b15,0x57c1, 0x4228,0x58f4,0xb461,0xa789, 0x41f5,0x0707,0x764b,0x67a7, 0x41b4,0x34d5,0x1a03,0xee01, 0x4171,0x1c22,0xd266,0x73a9, 0x4121,0x4b15,0xa677,0x9ef1, 0x40cf,0x5326,0x1a6a,0x0292, 0x4068,0x8df5,0xa7c3,0xf7e2, }; #endif /* md_log(zeta(x) - 1 - 2**-x), 10 <= x <= 50 */ #ifdef UNK static double A[11] = { 8.70728567484590192539E6, 1.76506865670346462757E8, 2.60889506707483264896E10, 5.29806374009894791647E11, 2.26888156119238241487E13, 3.31884402932705083599E14, 5.13778997975868230192E15, -1.98123688133907171455E15, -9.92763810039983572356E16, 7.82905376180870586444E16, 9.26786275768927717187E16, }; static double B[10] = { /* 1.00000000000000000000E0,*/ -7.92625410563741062861E6, -1.60529969932920229676E8, -2.37669260975543221788E10, -4.80319584350455169857E11, -2.07820961754173320170E13, -2.96075404507272223680E14, -4.86299103694609136686E15, 5.34589509675789930199E15, 5.71464111092297631292E16, -1.79915597658676556828E16, }; #endif #ifdef DEC static unsigned short A[44] = { 0046004,0156325,0126302,0131567, 0047050,0052177,0015271,0136466, 0050702,0060271,0070727,0171112, 0051766,0132727,0064363,0145042, 0053245,0012466,0056000,0117230, 0054226,0166155,0174275,0170213, 0055222,0003127,0112544,0101322, 0154741,0036625,0010346,0053767, 0156260,0054653,0154052,0031113, 0056213,0011152,0021000,0007111, 0056244,0120534,0040576,0163262, }; static unsigned short B[40] = { /*0040200,0000000,0000000,0000000,*/ 0145761,0161734,0033026,0015520, 0147031,0013743,0017355,0036703, 0150661,0011720,0061061,0136402, 0151737,0125216,0070274,0164414, 0153227,0032653,0127211,0145250, 0154206,0121666,0123774,0042035, 0155212,0033352,0125154,0132533, 0055227,0170201,0110775,0072132, 0056113,0003133,0127132,0122303, 0155577,0126351,0141462,0171037, }; #endif #ifdef IBMPC static unsigned short A[44] = { 0x566f,0xb598,0x9b9a,0x4160, 0x37a7,0xe357,0x0a8f,0x41a5, 0xfe49,0x2e3a,0x4c17,0x4218, 0x7944,0xed1e,0xd6ba,0x425e, 0x13d3,0xcb80,0xa2a6,0x42b4, 0xbe11,0xbf17,0xdd8d,0x42f2, 0x905a,0xf2ac,0x40ca,0x4332, 0xcaff,0xa21c,0x27b2,0xc31c, 0x4649,0x7b05,0x0b35,0xc376, 0x01c9,0x4440,0x624d,0x4371, 0xdcd6,0x882f,0x942b,0x4374, }; static unsigned short B[40] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xc36a,0x86c2,0x3c7b,0xc15e, 0xa7b8,0x63dd,0x22fc,0xc1a3, 0x37a0,0x0c46,0x227a,0xc216, 0x9d22,0xce17,0xf551,0xc25b, 0x3955,0x75d1,0xe6b5,0xc2b2, 0x8884,0xd4ff,0xd476,0xc2f0, 0x96ab,0x554d,0x46dd,0xc331, 0xae8b,0x323f,0xfe10,0x4332, 0x5498,0x75cb,0x60cb,0x4369, 0x5e44,0x3866,0xf59d,0xc34f, }; #endif #ifdef MIEEE static unsigned short A[44] = { 0x4160,0x9b9a,0xb598,0x566f, 0x41a5,0x0a8f,0xe357,0x37a7, 0x4218,0x4c17,0x2e3a,0xfe49, 0x425e,0xd6ba,0xed1e,0x7944, 0x42b4,0xa2a6,0xcb80,0x13d3, 0x42f2,0xdd8d,0xbf17,0xbe11, 0x4332,0x40ca,0xf2ac,0x905a, 0xc31c,0x27b2,0xa21c,0xcaff, 0xc376,0x0b35,0x7b05,0x4649, 0x4371,0x624d,0x4440,0x01c9, 0x4374,0x942b,0x882f,0xdcd6, }; static unsigned short B[40] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0xc15e,0x3c7b,0x86c2,0xc36a, 0xc1a3,0x22fc,0x63dd,0xa7b8, 0xc216,0x227a,0x0c46,0x37a0, 0xc25b,0xf551,0xce17,0x9d22, 0xc2b2,0xe6b5,0x75d1,0x3955, 0xc2f0,0xd476,0xd4ff,0x8884, 0xc331,0x46dd,0x554d,0x96ab, 0x4332,0xfe10,0x323f,0xae8b, 0x4369,0x60cb,0x75cb,0x5498, 0xc34f,0xf59d,0x3866,0x5e44, }; #endif /* (1-x) (zeta(x) - 1), 0 <= x <= 1 */ #ifdef UNK static double R[6] = { -3.28717474506562731748E-1, 1.55162528742623950834E1, -2.48762831680821954401E2, 1.01050368053237678329E3, 1.26726061410235149405E4, -1.11578094770515181334E5, }; static double S[5] = { /* 1.00000000000000000000E0,*/ 1.95107674914060531512E1, 3.17710311750646984099E2, 3.03835500874445748734E3, 2.03665876435770579345E4, 7.43853965136767874343E4, }; #endif #ifdef DEC static unsigned short R[24] = { 0137650,0046650,0022502,0040316, 0041170,0041222,0057666,0142216, 0142170,0141510,0167741,0075646, 0042574,0120074,0046505,0106053, 0043506,0001154,0130073,0101413, 0144331,0166414,0020560,0131652, }; static unsigned short S[20] = { /*0040200,0000000,0000000,0000000,*/ 0041234,0013015,0042073,0113570, 0042236,0155353,0077325,0077445, 0043075,0162656,0016646,0031723, 0043637,0016454,0157636,0071126, 0044221,0044262,0140365,0146434, }; #endif #ifdef IBMPC static unsigned short R[24] = { 0x481a,0x04a8,0x09b5,0xbfd5, 0xd892,0x4bf6,0x0852,0x402f, 0x2f75,0x1dfc,0x1869,0xc06f, 0xb185,0x89a8,0x9407,0x408f, 0x7061,0x9607,0xc04d,0x40c8, 0x1675,0x842e,0x3da1,0xc0fb, }; static unsigned short S[20] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x72ef,0xa887,0x82c1,0x4033, 0xafe5,0x6fda,0xdb5d,0x4073, 0xc67a,0xc3b4,0xbcb5,0x40a7, 0xce4b,0x9bf3,0xe3a5,0x40d3, 0xb9a3,0x581e,0x2916,0x40f2, }; #endif #ifdef MIEEE static unsigned short R[24] = { 0xbfd5,0x09b5,0x04a8,0x481a, 0x402f,0x0852,0x4bf6,0xd892, 0xc06f,0x1869,0x1dfc,0x2f75, 0x408f,0x9407,0x89a8,0xb185, 0x40c8,0xc04d,0x9607,0x7061, 0xc0fb,0x3da1,0x842e,0x1675, }; static unsigned short S[20] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4033,0x82c1,0xa887,0x72ef, 0x4073,0xdb5d,0x6fda,0xafe5, 0x40a7,0xbcb5,0xc3b4,0xc67a, 0x40d3,0xe3a5,0x9bf3,0xce4b, 0x40f2,0x2916,0x581e,0xb9a3, }; #endif #define MAXL2 127 /* * Riemann zeta function, minus one */ #ifdef ANSIPROT extern double md_sin ( double ); extern double md_floor ( double ); extern double md_gamma ( double ); extern double md_pow ( double, double ); extern double md_exp ( double ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); double zetac ( double ); #else double md_sin(), md_floor(), md_gamma(), md_pow(), md_exp(); double polevl(), p1evl(), zetac(); #endif extern double MACHEP; double zetac(x) double x; { int i; double a, b, s, w; if( x < 0.0 ) { #ifdef DEC if( x < -30.8148 ) #else if( x < -170.6243 ) #endif { mtherr( "zetac", OVERFLOW ); return(0.0); } s = 1.0 - x; w = zetac( s ); b = md_sin(0.5*PI*x) * md_pow(2.0*PI, x) * md_gamma(s) * (1.0 + w) / PI; return(b - 1.0); } if( x >= MAXL2 ) return(0.0); /* because first term is 2**-x */ /* Tabulated values for integer argument */ w = md_floor(x); if( w == x ) { i = x; if( i < 31 ) { #ifdef UNK return( azetac[i] ); #else return( *(double *)&azetac[4*i] ); #endif } } if( x < 1.0 ) { w = 1.0 - x; a = polevl( x, R, 5 ) / ( w * p1evl( x, S, 5 )); return( a ); } if( x == 1.0 ) { mtherr( "zetac", SING ); return( MAXNUM ); } if( x <= 10.0 ) { b = md_pow( 2.0, x ) * (x - 1.0); w = 1.0/x; s = (x * polevl( w, P, 8 )) / (b * p1evl( w, Q, 8 )); return( s ); } if( x <= 50.0 ) { b = md_pow( 2.0, -x ); w = polevl( x, A, 10 ) / p1evl( x, B, 10 ); w = md_exp(w) + b; return(w); } /* Basic sum of inverse powers */ s = 0.0; a = 1.0; do { a += 2.0; b = md_pow( a, -x ); s += b; } while( b/s > MACHEP ); b = md_pow( 2.0, -x ); s = (s + b)/(1.0-b); return(s); } Math-Cephes-0.5306/libmd/exp10.c0000644000175000017500000001232214757021403015764 0ustar shlomifshlomif/* md_exp10.c * * Base 10 exponential function * (Common antilogarithm) * * * * SYNOPSIS: * * double x, y, md_exp10(); * * y = md_exp10( x ); * * * * DESCRIPTION: * * Returns 10 raised to the x power. * * Range reduction is accomplished by expressing the argument * as 10**x = 2**n 10**f, with |f| < 0.5 md_log10(2). * The Pade' form * * 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) * * is used to approximate 10**f. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -307,+307 30000 2.2e-16 5.5e-17 * Test result from an earlier version (2.1): * DEC -38,+38 70000 3.1e-17 7.0e-18 * * ERROR MESSAGES: * * message condition value returned * md_exp10 underflow x < -MAXL10 0.0 * md_exp10 overflow x > MAXL10 MAXNUM * * DEC arithmetic: MAXL10 = 38.230809449325611792. * IEEE arithmetic: MAXL10 = 308.2547155599167. * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1991, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double P[] = { 4.09962519798587023075E-2, 1.17452732554344059015E1, 4.06717289936872725516E2, 2.39423741207388267439E3, }; static double Q[] = { /* 1.00000000000000000000E0,*/ 8.50936160849306532625E1, 1.27209271178345121210E3, 2.07960819286001865907E3, }; /* static double LOG102 = 3.01029995663981195214e-1; */ static double LOG210 = 3.32192809488736234787e0; static double LG102A = 3.01025390625000000000E-1; static double LG102B = 4.60503898119521373889E-6; /* static double MAXL10 = 38.230809449325611792; */ static double MAXL10 = 308.2547155599167; #endif #ifdef DEC static unsigned short P[] = { 0037047,0165657,0114061,0067234, 0041073,0166243,0123052,0144643, 0042313,0055720,0024032,0047443, 0043025,0121714,0070232,0050007, }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0041652,0027756,0071216,0050075, 0042637,0001367,0077263,0136017, 0043001,0174673,0024157,0133416, }; /* static unsigned short L102[] = {0037632,0020232,0102373,0147770}; #define LOG102 *(double *)L102 */ static unsigned short L210[] = {0040524,0115170,0045715,0015613}; #define LOG210 *(double *)L210 static unsigned short L102A[] = {0037632,0020000,0000000,0000000,}; #define LG102A *(double *)L102A static unsigned short L102B[] = {0033632,0102373,0147767,0114220,}; #define LG102B *(double *)L102B static unsigned short MXL[] = {0041430,0166131,0047761,0154130,}; #define MAXL10 ( *(double *)MXL ) #endif #ifdef IBMPC static unsigned short P[] = { 0x2dd4,0xf306,0xfd75,0x3fa4, 0x5934,0x74c5,0x7d94,0x4027, 0x49e4,0x0503,0x6b7a,0x4079, 0x4a01,0x8e13,0xb479,0x40a2, }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xca08,0xce51,0x45fd,0x4055, 0x7782,0xefd6,0xe05e,0x4093, 0xf6e2,0x650d,0x3f37,0x40a0, }; /* static unsigned short L102[] = {0x79ff,0x509f,0x4413,0x3fd3}; #define LOG102 *(double *)L102 */ static unsigned short L210[] = {0xa371,0x0979,0x934f,0x400a}; #define LOG210 *(double *)L210 static unsigned short L102A[] = {0x0000,0x0000,0x4400,0x3fd3,}; #define LG102A *(double *)L102A static unsigned short L102B[] = {0xf312,0x79fe,0x509f,0x3ed3,}; #define LG102B *(double *)L102B static double MAXL10 = 308.2547155599167; #endif #ifdef MIEEE static unsigned short P[] = { 0x3fa4,0xfd75,0xf306,0x2dd4, 0x4027,0x7d94,0x74c5,0x5934, 0x4079,0x6b7a,0x0503,0x49e4, 0x40a2,0xb479,0x8e13,0x4a01, }; static unsigned short Q[] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4055,0x45fd,0xce51,0xca08, 0x4093,0xe05e,0xefd6,0x7782, 0x40a0,0x3f37,0x650d,0xf6e2, }; /* static unsigned short L102[] = {0x3fd3,0x4413,0x509f,0x79ff}; #define LOG102 *(double *)L102 */ static unsigned short L210[] = {0x400a,0x934f,0x0979,0xa371}; #define LOG210 *(double *)L210 static unsigned short L102A[] = {0x3fd3,0x4400,0x0000,0x0000,}; #define LG102A *(double *)L102A static unsigned short L102B[] = {0x3ed3,0x509f,0x79fe,0xf312,}; #define LG102B *(double *)L102B static double MAXL10 = 308.2547155599167; #endif #ifdef ANSIPROT extern double md_floor ( double ); extern double md_ldexp ( double, int ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern int isnan ( double ); extern int isfinite ( double ); #else double md_floor(), md_ldexp(), polevl(), p1evl(); int isnan(), isfinite(); #endif extern double MAXNUM; #ifdef INFINITIES extern double INFINITY; #endif double md_exp10(x) double x; { double px, xx; short n; #ifdef NANS if( isnan(x) ) return(x); #endif if( x > MAXL10 ) { #ifdef INFINITIES return( INFINITY ); #else mtherr( "md_exp10", OVERFLOW ); return( MAXNUM ); #endif } if( x < -MAXL10 ) /* Would like to use MINLOG but can't */ { #ifndef INFINITIES mtherr( "md_exp10", UNDERFLOW ); #endif return(0.0); } /* Express 10**x = 10**g 2**n * = 10**g 10**( n md_log10(2) ) * = 10**( g + n md_log10(2) ) */ px = md_floor( LOG210 * x + 0.5 ); n = px; x -= px * LG102A; x -= px * LG102B; /* rational approximation for exponential * of the fractional part: * 10**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) */ xx = x * x; px = x * polevl( xx, P, 3 ); x = px/( p1evl( xx, Q, 3 ) - px ); x = 1.0 + md_ldexp( x, 1 ); /* multiply by power of 2 */ x = md_ldexp( x, n ); return(x); } Math-Cephes-0.5306/libmd/polevl.c0000644000175000017500000000310514757021403016327 0ustar shlomifshlomif/* polevl.c * p1evl.c * * Evaluate polynomial * * * * SYNOPSIS: * * int N; * double x, y, coef[N+1], polevl[]; * * y = polevl( x, coef, N ); * * * * DESCRIPTION: * * Evaluates polynomial of degree N: * * 2 N * y = C + C x + C x +...+ C x * 0 1 2 N * * Coefficients are stored in reverse order: * * coef[0] = C , ..., coef[N] = C . * N 0 * * The function p1evl() assumes that coef[N] = 1.0 and is * omitted from the array. Its calling arguments are * otherwise the same as polevl(). * * * SPEED: * * In the interest of speed, there are no checks for out * of bounds arithmetic. This routine is used by most of * the functions in the library. Depending on available * equipment features, the user may wish to rewrite the * program in microcode or assembly language. * */ /* Cephes Math Library Release 2.1: December, 1988 Copyright 1984, 1987, 1988 by Stephen L. Moshier Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */ double polevl( x, coef, N ) double x; double coef[]; int N; { double ans; int i; double *p; p = coef; ans = *p++; i = N; do ans = ans * x + *p++; while( --i ); return( ans ); } /* p1evl() */ /* N * Evaluate polynomial when coefficient of x is 1.0. * Otherwise same as polevl. */ double p1evl( x, coef, N ) double x; double coef[]; int N; { double ans; double *p; int i; p = coef; ans = x + *p++; i = N-1; do ans = ans * x + *p++; while( --i ); return( ans ); } Math-Cephes-0.5306/libmd/sici.c0000644000175000017500000003717514757021403015773 0ustar shlomifshlomif/* sici.c * * Sine and cosine integrals * * * * SYNOPSIS: * * double x, Ci, Si, sici(); * * sici( x, &Si, &Ci ); * * * DESCRIPTION: * * Evaluates the integrals * * x * - * | md_cos t - 1 * Ci(x) = eul + ln x + | --------- dt, * | t * - * 0 * x * - * | md_sin t * Si(x) = | ----- dt * | t * - * 0 * * where eul = 0.57721566490153286061 is Euler's constant. * The integrals are approximated by rational functions. * For x > 8 auxiliary functions f(x) and g(x) are employed * such that * * Ci(x) = f(x) md_sin(x) - g(x) md_cos(x) * Si(x) = pi/2 - f(x) md_cos(x) - g(x) md_sin(x) * * * ACCURACY: * Test interval = [0,50]. * Absolute error, except relative when > 1: * arithmetic function # trials peak rms * IEEE Si 30000 4.4e-16 7.3e-17 * IEEE Ci 30000 6.9e-16 5.1e-17 * DEC Si 5000 4.4e-17 9.0e-18 * DEC Ci 5300 7.9e-17 5.2e-18 */ /* Cephes Math Library Release 2.1: January, 1989 Copyright 1984, 1987, 1989 by Stephen L. Moshier Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */ #include "mconf.h" #ifdef UNK static double SN[] = { -8.39167827910303881427E-11, 4.62591714427012837309E-8, -9.75759303843632795789E-6, 9.76945438170435310816E-4, -4.13470316229406538752E-2, 1.00000000000000000302E0, }; static double SD[] = { 2.03269266195951942049E-12, 1.27997891179943299903E-9, 4.41827842801218905784E-7, 9.96412122043875552487E-5, 1.42085239326149893930E-2, 9.99999999999999996984E-1, }; #endif #ifdef DEC static unsigned short SN[] = { 0127670,0104362,0167505,0035161, 0032106,0127177,0032131,0056461, 0134043,0132213,0000476,0172351, 0035600,0006331,0064761,0032665, 0137051,0055601,0044667,0017645, 0040200,0000000,0000000,0000000, }; static unsigned short SD[] = { 0026417,0004674,0052064,0001573, 0030657,0165501,0014666,0131526, 0032755,0032133,0034147,0024124, 0034720,0173167,0166624,0154477, 0036550,0145336,0063534,0063220, 0040200,0000000,0000000,0000000, }; #endif #ifdef IBMPC static unsigned short SN[] = { 0xa74e,0x5de8,0x111e,0xbdd7, 0x2ba6,0xe68b,0xd5cf,0x3e68, 0xde9d,0x6027,0x7691,0xbee4, 0x26b7,0x2d3e,0x019b,0x3f50, 0xe3f5,0x2936,0x2b70,0xbfa5, 0x0000,0x0000,0x0000,0x3ff0, }; static unsigned short SD[] = { 0x806f,0x8a86,0xe137,0x3d81, 0xd66b,0x2336,0xfd68,0x3e15, 0xe50a,0x670c,0xa68b,0x3e9d, 0x9b28,0xfdb2,0x1ece,0x3f1a, 0x8cd2,0xcceb,0x195b,0x3f8d, 0x0000,0x0000,0x0000,0x3ff0, }; #endif #ifdef MIEEE static unsigned short SN[] = { 0xbdd7,0x111e,0x5de8,0xa74e, 0x3e68,0xd5cf,0xe68b,0x2ba6, 0xbee4,0x7691,0x6027,0xde9d, 0x3f50,0x019b,0x2d3e,0x26b7, 0xbfa5,0x2b70,0x2936,0xe3f5, 0x3ff0,0x0000,0x0000,0x0000, }; static unsigned short SD[] = { 0x3d81,0xe137,0x8a86,0x806f, 0x3e15,0xfd68,0x2336,0xd66b, 0x3e9d,0xa68b,0x670c,0xe50a, 0x3f1a,0x1ece,0xfdb2,0x9b28, 0x3f8d,0x195b,0xcceb,0x8cd2, 0x3ff0,0x0000,0x0000,0x0000, }; #endif #ifdef UNK static double CN[] = { 2.02524002389102268789E-11, -1.35249504915790756375E-8, 3.59325051419993077021E-6, -4.74007206873407909465E-4, 2.89159652607555242092E-2, -1.00000000000000000080E0, }; static double CD[] = { 4.07746040061880559506E-12, 3.06780997581887812692E-9, 1.23210355685883423679E-6, 3.17442024775032769882E-4, 5.10028056236446052392E-2, 4.00000000000000000080E0, }; #endif #ifdef DEC static unsigned short CN[] = { 0027262,0022131,0160257,0020166, 0131550,0055534,0077637,0000557, 0033561,0021622,0161463,0026575, 0135370,0102053,0116333,0000466, 0036754,0160454,0122022,0024622, 0140200,0000000,0000000,0000000, }; static unsigned short CD[] = { 0026617,0073177,0107543,0104425, 0031122,0150573,0156453,0041517, 0033245,0057301,0077706,0110510, 0035246,0067130,0165424,0044543, 0037120,0164121,0061206,0053657, 0040600,0000000,0000000,0000000, }; #endif #ifdef IBMPC static unsigned short CN[] = { 0xe40f,0x3c15,0x448b,0x3db6, 0xe02e,0x8ff3,0x0b6b,0xbe4d, 0x65b0,0x5c66,0x2472,0x3ece, 0x6027,0x739b,0x1085,0xbf3f, 0x4532,0x9482,0x9c25,0x3f9d, 0x0000,0x0000,0x0000,0xbff0, }; static unsigned short CD[] = { 0x7123,0xf1ec,0xeecf,0x3d91, 0x686a,0x7ba5,0x5a2f,0x3e2a, 0xd229,0x2ff8,0xabd8,0x3eb4, 0x892c,0x1d62,0xcdcb,0x3f34, 0xcaf6,0x2c50,0x1d0a,0x3faa, 0x0000,0x0000,0x0000,0x4010, }; #endif #ifdef MIEEE static unsigned short CN[] = { 0x3db6,0x448b,0x3c15,0xe40f, 0xbe4d,0x0b6b,0x8ff3,0xe02e, 0x3ece,0x2472,0x5c66,0x65b0, 0xbf3f,0x1085,0x739b,0x6027, 0x3f9d,0x9c25,0x9482,0x4532, 0xbff0,0x0000,0x0000,0x0000, }; static unsigned short CD[] = { 0x3d91,0xeecf,0xf1ec,0x7123, 0x3e2a,0x5a2f,0x7ba5,0x686a, 0x3eb4,0xabd8,0x2ff8,0xd229, 0x3f34,0xcdcb,0x1d62,0x892c, 0x3faa,0x1d0a,0x2c50,0xcaf6, 0x4010,0x0000,0x0000,0x0000, }; #endif #ifdef UNK static double FN4[] = { 4.23612862892216586994E0, 5.45937717161812843388E0, 1.62083287701538329132E0, 1.67006611831323023771E-1, 6.81020132472518137426E-3, 1.08936580650328664411E-4, 5.48900223421373614008E-7, }; static double FD4[] = { /* 1.00000000000000000000E0,*/ 8.16496634205391016773E0, 7.30828822505564552187E0, 1.86792257950184183883E0, 1.78792052963149907262E-1, 7.01710668322789753610E-3, 1.10034357153915731354E-4, 5.48900252756255700982E-7, }; #endif #ifdef DEC static unsigned short FN4[] = { 0040607,0107135,0120133,0153471, 0040656,0131467,0140424,0017567, 0040317,0073563,0121610,0002511, 0037453,0001710,0000040,0006334, 0036337,0024033,0176003,0171425, 0034744,0072341,0121657,0126035, 0033023,0054042,0154652,0000451, }; static unsigned short FD4[] = { /*0040200,0000000,0000000,0000000,*/ 0041002,0121663,0137500,0177450, 0040751,0156577,0042213,0061552, 0040357,0014026,0045465,0147265, 0037467,0012503,0110413,0131772, 0036345,0167701,0155706,0160551, 0034746,0141076,0162250,0123547, 0033023,0054043,0056706,0151050, }; #endif #ifdef IBMPC static unsigned short FN4[] = { 0x7ae7,0xb40b,0xf1cb,0x4010, 0x83ef,0xf822,0xd666,0x4015, 0x00a9,0x7471,0xeeee,0x3ff9, 0x019c,0x0004,0x6079,0x3fc5, 0x7e63,0x7f80,0xe503,0x3f7b, 0xf584,0x3475,0x8e9c,0x3f1c, 0x4025,0x5b35,0x6b04,0x3ea2, }; static unsigned short FD4[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x1fe5,0x77e8,0x5476,0x4020, 0x6c6d,0xe891,0x3baf,0x401d, 0xb9d7,0xc966,0xe302,0x3ffd, 0x767f,0x7221,0xe2a8,0x3fc6, 0xdc2d,0x3b78,0xbdf8,0x3f7c, 0x14ed,0xdc95,0xd847,0x3f1c, 0xda45,0x6bb8,0x6b04,0x3ea2, }; #endif #ifdef MIEEE static unsigned short FN4[] = { 0x4010,0xf1cb,0xb40b,0x7ae7, 0x4015,0xd666,0xf822,0x83ef, 0x3ff9,0xeeee,0x7471,0x00a9, 0x3fc5,0x6079,0x0004,0x019c, 0x3f7b,0xe503,0x7f80,0x7e63, 0x3f1c,0x8e9c,0x3475,0xf584, 0x3ea2,0x6b04,0x5b35,0x4025, }; static unsigned short FD4[] = { /* 0x3ff0,0x0000,0x0000,0x0000,*/ 0x4020,0x5476,0x77e8,0x1fe5, 0x401d,0x3baf,0xe891,0x6c6d, 0x3ffd,0xe302,0xc966,0xb9d7, 0x3fc6,0xe2a8,0x7221,0x767f, 0x3f7c,0xbdf8,0x3b78,0xdc2d, 0x3f1c,0xd847,0xdc95,0x14ed, 0x3ea2,0x6b04,0x6bb8,0xda45, }; #endif #ifdef UNK static double FN8[] = { 4.55880873470465315206E-1, 7.13715274100146711374E-1, 1.60300158222319456320E-1, 1.16064229408124407915E-2, 3.49556442447859055605E-4, 4.86215430826454749482E-6, 3.20092790091004902806E-8, 9.41779576128512936592E-11, 9.70507110881952024631E-14, }; static double FD8[] = { /* 1.00000000000000000000E0,*/ 9.17463611873684053703E-1, 1.78685545332074536321E-1, 1.22253594771971293032E-2, 3.58696481881851580297E-4, 4.92435064317881464393E-6, 3.21956939101046018377E-8, 9.43720590350276732376E-11, 9.70507110881952025725E-14, }; #endif #ifdef DEC static unsigned short FN8[] = { 0037751,0064467,0142332,0164573, 0040066,0133013,0050352,0071102, 0037444,0022671,0102157,0013535, 0036476,0024335,0136423,0146444, 0035267,0042253,0164110,0110460, 0033643,0022626,0062535,0060320, 0032011,0075223,0010110,0153413, 0027717,0014572,0011360,0014034, 0025332,0104755,0004563,0152354, }; static unsigned short FD8[] = { /*0040200,0000000,0000000,0000000,*/ 0040152,0157345,0030104,0075616, 0037466,0174527,0172740,0071060, 0036510,0046337,0144272,0156552, 0035274,0007555,0042537,0015572, 0033645,0035731,0112465,0026474, 0032012,0043612,0030613,0030123, 0027717,0103277,0004564,0151000, 0025332,0104755,0004563,0152354, }; #endif #ifdef IBMPC static unsigned short FN8[] = { 0x5d2f,0xf89b,0x2d26,0x3fdd, 0x4e48,0x6a1d,0xd6c1,0x3fe6, 0xe2ec,0x308d,0x84b7,0x3fc4, 0x79a4,0xb7a2,0xc51b,0x3f87, 0x1226,0x7d09,0xe895,0x3f36, 0xac1a,0xccab,0x64b2,0x3ed4, 0x1ae1,0x6209,0x2f52,0x3e61, 0x0304,0x425e,0xe32f,0x3dd9, 0x7a9d,0xa12e,0x513d,0x3d3b, }; static unsigned short FD8[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x8f72,0xa608,0x5bdc,0x3fed, 0x0e46,0xfebc,0xdf2a,0x3fc6, 0x5bad,0xf917,0x099b,0x3f89, 0xe36f,0xa8ab,0x81ed,0x3f37, 0xa5a8,0x32a6,0xa77b,0x3ed4, 0x660a,0x4631,0x48f1,0x3e61, 0x9a40,0xe12e,0xf0d7,0x3dd9, 0x7a9d,0xa12e,0x513d,0x3d3b, }; #endif #ifdef MIEEE static unsigned short FN8[] = { 0x3fdd,0x2d26,0xf89b,0x5d2f, 0x3fe6,0xd6c1,0x6a1d,0x4e48, 0x3fc4,0x84b7,0x308d,0xe2ec, 0x3f87,0xc51b,0xb7a2,0x79a4, 0x3f36,0xe895,0x7d09,0x1226, 0x3ed4,0x64b2,0xccab,0xac1a, 0x3e61,0x2f52,0x6209,0x1ae1, 0x3dd9,0xe32f,0x425e,0x0304, 0x3d3b,0x513d,0xa12e,0x7a9d, }; static unsigned short FD8[] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x3fed,0x5bdc,0xa608,0x8f72, 0x3fc6,0xdf2a,0xfebc,0x0e46, 0x3f89,0x099b,0xf917,0x5bad, 0x3f37,0x81ed,0xa8ab,0xe36f, 0x3ed4,0xa77b,0x32a6,0xa5a8, 0x3e61,0x48f1,0x4631,0x660a, 0x3dd9,0xf0d7,0xe12e,0x9a40, 0x3d3b,0x513d,0xa12e,0x7a9d, }; #endif #ifdef UNK static double GN4[] = { 8.71001698973114191777E-2, 6.11379109952219284151E-1, 3.97180296392337498885E-1, 7.48527737628469092119E-2, 5.38868681462177273157E-3, 1.61999794598934024525E-4, 1.97963874140963632189E-6, 7.82579040744090311069E-9, }; static double GD4[] = { /* 1.00000000000000000000E0,*/ 1.64402202413355338886E0, 6.66296701268987968381E-1, 9.88771761277688796203E-2, 6.22396345441768420760E-3, 1.73221081474177119497E-4, 2.02659182086343991969E-6, 7.82579218933534490868E-9, }; #endif #ifdef DEC static unsigned short GN4[] = { 0037262,0060622,0164572,0157515, 0040034,0101527,0061263,0147204, 0037713,0055467,0037475,0144512, 0037231,0046151,0035234,0045261, 0036260,0111624,0150617,0053536, 0035051,0157175,0016675,0155456, 0033404,0154757,0041211,0000055, 0031406,0071060,0130322,0033322, }; static unsigned short GD4[] = { /* 0040200,0000000,0000000,0000000,*/ 0040322,0067520,0046707,0053275, 0040052,0111153,0126542,0005516, 0037312,0100035,0167121,0014552, 0036313,0171143,0137176,0014213, 0035065,0121256,0012033,0150603, 0033410,0000225,0013121,0071643, 0031406,0071062,0131152,0150454, }; #endif #ifdef IBMPC static unsigned short GN4[] = { 0x5bea,0x5d2f,0x4c32,0x3fb6, 0x79d1,0xec56,0x906a,0x3fe3, 0xb929,0xe7e7,0x6b66,0x3fd9, 0x8956,0x2753,0x298d,0x3fb3, 0xeaec,0x9a31,0x1272,0x3f76, 0xbb66,0xa3b7,0x3bcf,0x3f25, 0x2006,0xe851,0x9b3d,0x3ec0, 0x46da,0x161a,0xce46,0x3e40, }; static unsigned short GD4[] = { /* 0x0000,0x0000,0x0000,0x3ff0,*/ 0xead8,0x09b8,0x4dea,0x3ffa, 0x416a,0x75ac,0x524d,0x3fe5, 0x232d,0xbdca,0x5003,0x3fb9, 0xc311,0x77cf,0x7e4c,0x3f79, 0x7a30,0xc283,0xb455,0x3f26, 0x2e74,0xa2ca,0x0012,0x3ec1, 0x5a26,0x564d,0xce46,0x3e40, }; #endif #ifdef MIEEE static unsigned short GN4[] = { 0x3fb6,0x4c32,0x5d2f,0x5bea, 0x3fe3,0x906a,0xec56,0x79d1, 0x3fd9,0x6b66,0xe7e7,0xb929, 0x3fb3,0x298d,0x2753,0x8956, 0x3f76,0x1272,0x9a31,0xeaec, 0x3f25,0x3bcf,0xa3b7,0xbb66, 0x3ec0,0x9b3d,0xe851,0x2006, 0x3e40,0xce46,0x161a,0x46da, }; static unsigned short GD4[] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x3ffa,0x4dea,0x09b8,0xead8, 0x3fe5,0x524d,0x75ac,0x416a, 0x3fb9,0x5003,0xbdca,0x232d, 0x3f79,0x7e4c,0x77cf,0xc311, 0x3f26,0xb455,0xc283,0x7a30, 0x3ec1,0x0012,0xa2ca,0x2e74, 0x3e40,0xce46,0x564d,0x5a26, }; #endif #ifdef UNK static double GN8[] = { 6.97359953443276214934E-1, 3.30410979305632063225E-1, 3.84878767649974295920E-2, 1.71718239052347903558E-3, 3.48941165502279436777E-5, 3.47131167084116673800E-7, 1.70404452782044526189E-9, 3.85945925430276600453E-12, 3.14040098946363334640E-15, }; static double GD8[] = { /* 1.00000000000000000000E0,*/ 1.68548898811011640017E0, 4.87852258695304967486E-1, 4.67913194259625806320E-2, 1.90284426674399523638E-3, 3.68475504442561108162E-5, 3.57043223443740838771E-7, 1.72693748966316146736E-9, 3.87830166023954706752E-12, 3.14040098946363335242E-15, }; #endif #ifdef DEC static unsigned short GN8[] = { 0040062,0103056,0110624,0033123, 0037651,0025640,0136266,0145647, 0037035,0122566,0137770,0061777, 0035741,0011424,0065311,0013370, 0034422,0055505,0134324,0016755, 0032672,0056530,0022565,0014747, 0030752,0031674,0114735,0013162, 0026607,0145353,0022020,0123625, 0024142,0045054,0060033,0016505, }; static unsigned short GD8[] = { /*0040200,0000000,0000000,0000000,*/ 0040327,0137032,0064331,0136425, 0037771,0143705,0070300,0105711, 0037077,0124101,0025275,0035356, 0035771,0064333,0145103,0105357, 0034432,0106301,0105311,0010713, 0032677,0127645,0120034,0157551, 0030755,0054466,0010743,0105566, 0026610,0072242,0142530,0135744, 0024142,0045054,0060033,0016505, }; #endif #ifdef IBMPC static unsigned short GN8[] = { 0x86ca,0xd232,0x50c5,0x3fe6, 0xd975,0x1796,0x2574,0x3fd5, 0x0c80,0xd7ff,0xb4ae,0x3fa3, 0x22df,0x8d59,0x2262,0x3f5c, 0x83be,0xb71a,0x4b68,0x3f02, 0xa33d,0x04ae,0x4bab,0x3e97, 0xa2ce,0x933b,0x4677,0x3e1d, 0x14f3,0x6482,0xf95d,0x3d90, 0x63a9,0x8c03,0x4945,0x3cec, }; static unsigned short GD8[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x37a3,0x4d1b,0xf7c3,0x3ffa, 0x1179,0xae18,0x38f8,0x3fdf, 0xa75e,0x2557,0xf508,0x3fa7, 0x715e,0x7948,0x2d1b,0x3f5f, 0x2239,0x3159,0x5198,0x3f03, 0x9bed,0xb403,0xf5f4,0x3e97, 0x716f,0xc23c,0xab26,0x3e1d, 0x177c,0x58ab,0x0e94,0x3d91, 0x63a9,0x8c03,0x4945,0x3cec, }; #endif #ifdef MIEEE static unsigned short GN8[] = { 0x3fe6,0x50c5,0xd232,0x86ca, 0x3fd5,0x2574,0x1796,0xd975, 0x3fa3,0xb4ae,0xd7ff,0x0c80, 0x3f5c,0x2262,0x8d59,0x22df, 0x3f02,0x4b68,0xb71a,0x83be, 0x3e97,0x4bab,0x04ae,0xa33d, 0x3e1d,0x4677,0x933b,0xa2ce, 0x3d90,0xf95d,0x6482,0x14f3, 0x3cec,0x4945,0x8c03,0x63a9, }; static unsigned short GD8[] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x3ffa,0xf7c3,0x4d1b,0x37a3, 0x3fdf,0x38f8,0xae18,0x1179, 0x3fa7,0xf508,0x2557,0xa75e, 0x3f5f,0x2d1b,0x7948,0x715e, 0x3f03,0x5198,0x3159,0x2239, 0x3e97,0xf5f4,0xb403,0x9bed, 0x3e1d,0xab26,0xc23c,0x716f, 0x3d91,0x0e94,0x58ab,0x177c, 0x3cec,0x4945,0x8c03,0x63a9, }; #endif #ifdef ANSIPROT extern double md_log ( double ); extern double md_sin ( double ); extern double md_cos ( double ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); #else double md_log(), md_sin(), md_cos(), polevl(), p1evl(); #endif #define EUL 0.57721566490153286061 extern double MAXNUM, PIO2, MACHEP; int sici( x, si, ci ) double x; double *si, *ci; { double z, c, s, f, g; short sign; if( x < 0.0 ) { sign = -1; x = -x; } else sign = 0; if( x == 0.0 ) { *si = 0.0; *ci = -MAXNUM; return( 0 ); } if( x > 1.0e9 ) { *si = PIO2 - md_cos(x)/x; *ci = md_sin(x)/x; return( 0 ); } if( x > 4.0 ) goto asympt; z = x * x; s = x * polevl( z, SN, 5 ) / polevl( z, SD, 5 ); c = z * polevl( z, CN, 5 ) / polevl( z, CD, 5 ); if( sign ) s = -s; *si = s; *ci = EUL + md_log(x) + c; /* real part if x < 0 */ return(0); /* The auxiliary functions are: * * * *si = *si - PIO2; * c = md_cos(x); * s = md_sin(x); * * t = *ci * s - *si * c; * a = *ci * c + *si * s; * * *si = t; * *ci = -a; */ asympt: s = md_sin(x); c = md_cos(x); z = 1.0/(x*x); if( x < 8.0 ) { f = polevl( z, FN4, 6 ) / (x * p1evl( z, FD4, 7 )); g = z * polevl( z, GN4, 7 ) / p1evl( z, GD4, 7 ); } else { f = polevl( z, FN8, 8 ) / (x * p1evl( z, FD8, 8 )); g = z * polevl( z, GN8, 8 ) / p1evl( z, GD8, 9 ); } *si = PIO2 - f * c - g * s; if( sign ) *si = -( *si ); *ci = f * s - g * c; return(0); } Math-Cephes-0.5306/libmd/incbet.c0000644000175000017500000001561114757021403016277 0ustar shlomifshlomif/* incbet.c * * Incomplete beta integral * * * SYNOPSIS: * * double a, b, x, y, incbet(); * * y = incbet( a, b, x ); * * * DESCRIPTION: * * Returns incomplete beta integral of the arguments, evaluated * from zero to x. The function is defined as * * x * - - * | (a+b) | | a-1 b-1 * ----------- | t (1-t) dt. * - - | | * | (a) | (b) - * 0 * * The domain of definition is 0 <= x <= 1. In this * implementation a and b are restricted to positive values. * The integral from x to 1 may be obtained by the symmetry * relation * * 1 - incbet( a, b, x ) = incbet( b, a, 1-x ). * * The integral is evaluated by a continued fraction expansion * or, when b*x is small, by a power series. * * ACCURACY: * * Tested at uniformly distributed random points (a,b,x) with a and b * in "domain" and x between 0 and 1. * Relative error * arithmetic domain # trials peak rms * IEEE 0,5 10000 6.9e-15 4.5e-16 * IEEE 0,85 250000 2.2e-13 1.7e-14 * IEEE 0,1000 30000 5.3e-12 6.3e-13 * IEEE 0,10000 250000 9.3e-11 7.1e-12 * IEEE 0,100000 10000 8.7e-10 4.8e-11 * Outputs smaller than the IEEE gradual underflow threshold * were excluded from these statistics. * * ERROR MESSAGES: * message condition value returned * incbet domain x<0, x>1 0.0 * incbet underflow 0.0 */ /* Cephes Math Library, Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef DEC #define MAXGAM 34.84425627277176174 #else #define MAXGAM 171.624376956302725 #endif extern double MACHEP, MINLOG, MAXLOG; #ifdef ANSIPROT extern double md_gamma ( double ); extern double lgam ( double ); extern double md_exp ( double ); extern double md_log ( double ); extern double md_pow ( double, double ); extern double md_fabs ( double ); static double incbcf(double, double, double); static double incbd(double, double, double); static double pseries(double, double, double); #else double md_gamma(), lgam(), md_exp(), md_log(), md_pow(), md_fabs(); static double incbcf(), incbd(), pseries(); #endif static double big = 4.503599627370496e15; static double biginv = 2.22044604925031308085e-16; double incbet( aa, bb, xx ) double aa, bb, xx; { double a, b, t, x, xc, w, y; int flag; if( aa <= 0.0 || bb <= 0.0 ) goto domerr; if( (xx <= 0.0) || ( xx >= 1.0) ) { if( xx == 0.0 ) return(0.0); if( xx == 1.0 ) return( 1.0 ); domerr: mtherr( "incbet", DOMAIN ); return( 0.0 ); } flag = 0; if( (bb * xx) <= 1.0 && xx <= 0.95) { t = pseries(aa, bb, xx); goto done; } w = 1.0 - xx; /* Reverse a and b if x is greater than the mean. */ if( xx > (aa/(aa+bb)) ) { flag = 1; a = bb; b = aa; xc = xx; x = w; } else { a = aa; b = bb; xc = w; x = xx; } if( flag == 1 && (b * x) <= 1.0 && x <= 0.95) { t = pseries(a, b, x); goto done; } /* Choose expansion for better convergence. */ y = x * (a+b-2.0) - (a-1.0); if( y < 0.0 ) w = incbcf( a, b, x ); else w = incbd( a, b, x ) / xc; /* Multiply w by the factor a b _ _ _ x (1-x) | (a+b) / ( a | (a) | (b) ) . */ y = a * md_log(x); t = b * md_log(xc); if( (a+b) < MAXGAM && md_fabs(y) < MAXLOG && md_fabs(t) < MAXLOG ) { t = md_pow(xc,b); t *= md_pow(x,a); t /= a; t *= w; t *= md_gamma(a+b) / (md_gamma(a) * md_gamma(b)); goto done; } /* Resort to logarithms. */ y += t + lgam(a+b) - lgam(a) - lgam(b); y += md_log(w/a); if( y < MINLOG ) t = 0.0; else t = md_exp(y); done: if( flag == 1 ) { if( t <= MACHEP ) t = 1.0 - MACHEP; else t = 1.0 - t; } return( t ); } /* Continued fraction expansion #1 * for incomplete beta integral */ static double incbcf( a, b, x ) double a, b, x; { double xk, pk, pkm1, pkm2, qk, qkm1, qkm2; double k1, k2, k3, k4, k5, k6, k7, k8; double r, t, ans, thresh; int n; k1 = a; k2 = a + b; k3 = a; k4 = a + 1.0; k5 = 1.0; k6 = b - 1.0; k7 = k4; k8 = a + 2.0; pkm2 = 0.0; qkm2 = 1.0; pkm1 = 1.0; qkm1 = 1.0; ans = 1.0; r = 1.0; n = 0; thresh = 3.0 * MACHEP; do { xk = -( x * k1 * k2 )/( k3 * k4 ); pk = pkm1 + pkm2 * xk; qk = qkm1 + qkm2 * xk; pkm2 = pkm1; pkm1 = pk; qkm2 = qkm1; qkm1 = qk; xk = ( x * k5 * k6 )/( k7 * k8 ); pk = pkm1 + pkm2 * xk; qk = qkm1 + qkm2 * xk; pkm2 = pkm1; pkm1 = pk; qkm2 = qkm1; qkm1 = qk; if( qk != 0 ) r = pk/qk; if( r != 0 ) { t = md_fabs( (ans - r)/r ); ans = r; } else t = 1.0; if( t < thresh ) goto cdone; k1 += 1.0; k2 += 1.0; k3 += 2.0; k4 += 2.0; k5 += 1.0; k6 -= 1.0; k7 += 2.0; k8 += 2.0; if( (md_fabs(qk) + md_fabs(pk)) > big ) { pkm2 *= biginv; pkm1 *= biginv; qkm2 *= biginv; qkm1 *= biginv; } if( (md_fabs(qk) < biginv) || (md_fabs(pk) < biginv) ) { pkm2 *= big; pkm1 *= big; qkm2 *= big; qkm1 *= big; } } while( ++n < 300 ); cdone: return(ans); } /* Continued fraction expansion #2 * for incomplete beta integral */ static double incbd( a, b, x ) double a, b, x; { double xk, pk, pkm1, pkm2, qk, qkm1, qkm2; double k1, k2, k3, k4, k5, k6, k7, k8; double r, t, ans, z, thresh; int n; k1 = a; k2 = b - 1.0; k3 = a; k4 = a + 1.0; k5 = 1.0; k6 = a + b; k7 = a + 1.0;; k8 = a + 2.0; pkm2 = 0.0; qkm2 = 1.0; pkm1 = 1.0; qkm1 = 1.0; z = x / (1.0-x); ans = 1.0; r = 1.0; n = 0; thresh = 3.0 * MACHEP; do { xk = -( z * k1 * k2 )/( k3 * k4 ); pk = pkm1 + pkm2 * xk; qk = qkm1 + qkm2 * xk; pkm2 = pkm1; pkm1 = pk; qkm2 = qkm1; qkm1 = qk; xk = ( z * k5 * k6 )/( k7 * k8 ); pk = pkm1 + pkm2 * xk; qk = qkm1 + qkm2 * xk; pkm2 = pkm1; pkm1 = pk; qkm2 = qkm1; qkm1 = qk; if( qk != 0 ) r = pk/qk; if( r != 0 ) { t = md_fabs( (ans - r)/r ); ans = r; } else t = 1.0; if( t < thresh ) goto cdone; k1 += 1.0; k2 -= 1.0; k3 += 2.0; k4 += 2.0; k5 += 1.0; k6 += 1.0; k7 += 2.0; k8 += 2.0; if( (md_fabs(qk) + md_fabs(pk)) > big ) { pkm2 *= biginv; pkm1 *= biginv; qkm2 *= biginv; qkm1 *= biginv; } if( (md_fabs(qk) < biginv) || (md_fabs(pk) < biginv) ) { pkm2 *= big; pkm1 *= big; qkm2 *= big; qkm1 *= big; } } while( ++n < 300 ); cdone: return(ans); } /* Power series for incomplete beta integral. Use when b*x is small and x not too close to 1. */ static double pseries( a, b, x ) double a, b, x; { double s, t, u, v, n, t1, z, ai; ai = 1.0 / a; u = (1.0 - b) * x; v = u / (a + 1.0); t1 = v; t = u; n = 2.0; s = 0.0; z = MACHEP * ai; while( md_fabs(v) > z ) { u = (n - b) * x / n; t *= u; v = t / (a + n); s += v; n += 1.0; } s += t1; s += ai; u = a * md_log(x); if( (a+b) < MAXGAM && md_fabs(u) < MAXLOG ) { t = md_gamma(a+b)/(md_gamma(a)*md_gamma(b)); s = s * t * md_pow(x,a); } else { t = lgam(a+b) - lgam(a) - lgam(b) + u + md_log(s); if( t < MINLOG ) s = 0.0; else s = md_exp(t); } return(s); } Math-Cephes-0.5306/libmd/minv.c0000644000175000017500000000215314757021403016001 0ustar shlomifshlomif/* minv.c * * Matrix inversion * * * * SYNOPSIS: * * int n, errcod; * double A[n*n], X[n*n]; * double B[n]; * int IPS[n]; * int minv(); * * errcod = minv( A, X, n, B, IPS ); * * * * DESCRIPTION: * * Finds the inverse of the n by n matrix A. The result goes * to X. B and IPS are scratch pad arrays of length n. * The contents of matrix A are destroyed. * * The routine returns nonzero on error; error messages are printed * by subroutine simq(). * */ int minv( A, X, n, B, IPS ) double A[], X[]; int n; double B[]; int IPS[]; { double *pX; int i, k; extern int simq(double *, double *, double *, int, int, int *); extern void mtransp(int, double *, double *); for( i=1; i 1: * DEC Chi 2500 9.3e-17 * IEEE Chi 30000 8.4e-16 1.4e-16 */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK /* x md_exp(-x) shi(x), inverted interval 8 to 18 */ static double S1[] = { 1.83889230173399459482E-17, -9.55485532279655569575E-17, 2.04326105980879882648E-16, 1.09896949074905343022E-15, -1.31313534344092599234E-14, 5.93976226264314278932E-14, -3.47197010497749154755E-14, -1.40059764613117131000E-12, 9.49044626224223543299E-12, -1.61596181145435454033E-11, -1.77899784436430310321E-10, 1.35455469767246947469E-9, -1.03257121792819495123E-9, -3.56699611114982536845E-8, 1.44818877384267342057E-7, 7.82018215184051295296E-7, -5.39919118403805073710E-6, -3.12458202168959833422E-5, 8.90136741950727517826E-5, 2.02558474743846862168E-3, 2.96064440855633256972E-2, 1.11847751047257036625E0 }; /* x md_exp(-x) shi(x), inverted interval 18 to 88 */ static double S2[] = { -1.05311574154850938805E-17, 2.62446095596355225821E-17, 8.82090135625368160657E-17, -3.38459811878103047136E-16, -8.30608026366935789136E-16, 3.93397875437050071776E-15, 1.01765565969729044505E-14, -4.21128170307640802703E-14, -1.60818204519802480035E-13, 3.34714954175994481761E-13, 2.72600352129153073807E-12, 1.66894954752839083608E-12, -3.49278141024730899554E-11, -1.58580661666482709598E-10, -1.79289437183355633342E-10, 1.76281629144264523277E-9, 1.69050228879421288846E-8, 1.25391771228487041649E-7, 1.16229947068677338732E-6, 1.61038260117376323993E-5, 3.49810375601053973070E-4, 1.28478065259647610779E-2, 1.03665722588798326712E0 }; #endif #ifdef DEC static unsigned short S1[] = { 0022251,0115635,0165120,0006574, 0122734,0050751,0020305,0101356, 0023153,0111154,0011103,0177462, 0023636,0060321,0060253,0124246, 0124554,0106655,0152525,0166400, 0025205,0140145,0171006,0106556, 0125034,0056427,0004205,0176022, 0126305,0016731,0025011,0134453, 0027046,0172453,0112604,0116235, 0127216,0022071,0116600,0137667, 0130103,0115126,0071104,0052535, 0030672,0025450,0010071,0141414, 0130615,0165136,0132137,0177737, 0132031,0031611,0074436,0175407, 0032433,0077602,0104345,0060076, 0033121,0165741,0167177,0172433, 0133665,0025262,0174621,0022612, 0134403,0006761,0124566,0145405, 0034672,0126332,0034737,0116744, 0036004,0137654,0037332,0131766, 0036762,0104466,0121445,0124326, 0040217,0025105,0062145,0042640 }; static unsigned short S2[] = { 0122102,0041774,0016051,0055137, 0022362,0010125,0007651,0015773, 0022713,0062551,0040227,0071645, 0123303,0015732,0025731,0146570, 0123557,0064016,0002067,0067711, 0024215,0136214,0132374,0124234, 0024467,0051425,0071066,0064210, 0125075,0124305,0135123,0024170, 0125465,0010261,0005560,0034232, 0025674,0066602,0030724,0174557, 0026477,0151520,0051510,0067250, 0026352,0161076,0113154,0116271, 0127431,0116470,0177465,0127274, 0130056,0056174,0170315,0013321, 0130105,0020575,0075327,0036710, 0030762,0043625,0113046,0125035, 0031621,0033211,0154354,0022077, 0032406,0121555,0074270,0041141, 0033234,0000116,0041611,0173743, 0034207,0013263,0174715,0115563, 0035267,0063300,0175753,0117266, 0036522,0077633,0033255,0136200, 0040204,0130457,0014454,0166254 }; #endif #ifdef IBMPC static unsigned short S1[] = { 0x01b0,0xbd4a,0x3373,0x3c75, 0xb05e,0x2418,0x8a3d,0xbc9b, 0x7fe6,0x8248,0x724d,0x3cad, 0x7515,0x2c15,0xcc1a,0x3cd3, 0xbda0,0xbaaa,0x91b5,0xbd0d, 0xd1ae,0xbe40,0xb80c,0x3d30, 0xbf82,0xe110,0x8ba2,0xbd23, 0x3725,0x2541,0xa3bb,0xbd78, 0x9394,0x72b0,0xdea5,0x3da4, 0x17f7,0x33b0,0xc487,0xbdb1, 0x8aac,0xce48,0x734a,0xbde8, 0x3862,0x0207,0x4565,0x3e17, 0xfffc,0xd68b,0xbd4b,0xbe11, 0xdf61,0x2f23,0x2671,0xbe63, 0xac08,0x511c,0x6ff0,0x3e83, 0xfea3,0x3dcf,0x3d7c,0x3eaa, 0x24b1,0x5f32,0xa556,0xbed6, 0xd961,0x352e,0x61be,0xbf00, 0xf3bd,0x473b,0x559b,0x3f17, 0x567f,0x87db,0x97f5,0x3f60, 0xb51b,0xd464,0x5126,0x3f9e, 0xa8b4,0xac8c,0xe548,0x3ff1 }; static unsigned short S2[] = { 0x2b4c,0x8385,0x487f,0xbc68, 0x237f,0xa1f5,0x420a,0x3c7e, 0xee75,0x2812,0x6cad,0x3c99, 0x39af,0x457b,0x637b,0xbcb8, 0xedf9,0xc086,0xed01,0xbccd, 0x9513,0x969f,0xb791,0x3cf1, 0xcd11,0xae46,0xea62,0x3d06, 0x650f,0xb74a,0xb518,0xbd27, 0x0713,0x216e,0xa216,0xbd46, 0x9f2e,0x463a,0x8db0,0x3d57, 0x0dd5,0x0a69,0xfa6a,0x3d87, 0x9397,0xd2cd,0x5c47,0x3d7d, 0xb5d8,0x1fe6,0x33a7,0xbdc3, 0xa2da,0x9e19,0xcb8f,0xbde5, 0xe7b9,0xaf5a,0xa42f,0xbde8, 0xd544,0xb2c4,0x48f2,0x3e1e, 0x8488,0x3b1d,0x26d1,0x3e52, 0x084c,0xaf17,0xd46d,0x3e80, 0x3efc,0xc871,0x8009,0x3eb3, 0xb36e,0x7f39,0xe2d6,0x3ef0, 0x73d7,0x1f7d,0xecd8,0x3f36, 0xb790,0x66d5,0x4ff3,0x3f8a, 0x9d96,0xe325,0x9625,0x3ff0 }; #endif #ifdef MIEEE static unsigned short S1[] = { 0x3c75,0x3373,0xbd4a,0x01b0, 0xbc9b,0x8a3d,0x2418,0xb05e, 0x3cad,0x724d,0x8248,0x7fe6, 0x3cd3,0xcc1a,0x2c15,0x7515, 0xbd0d,0x91b5,0xbaaa,0xbda0, 0x3d30,0xb80c,0xbe40,0xd1ae, 0xbd23,0x8ba2,0xe110,0xbf82, 0xbd78,0xa3bb,0x2541,0x3725, 0x3da4,0xdea5,0x72b0,0x9394, 0xbdb1,0xc487,0x33b0,0x17f7, 0xbde8,0x734a,0xce48,0x8aac, 0x3e17,0x4565,0x0207,0x3862, 0xbe11,0xbd4b,0xd68b,0xfffc, 0xbe63,0x2671,0x2f23,0xdf61, 0x3e83,0x6ff0,0x511c,0xac08, 0x3eaa,0x3d7c,0x3dcf,0xfea3, 0xbed6,0xa556,0x5f32,0x24b1, 0xbf00,0x61be,0x352e,0xd961, 0x3f17,0x559b,0x473b,0xf3bd, 0x3f60,0x97f5,0x87db,0x567f, 0x3f9e,0x5126,0xd464,0xb51b, 0x3ff1,0xe548,0xac8c,0xa8b4 }; static unsigned short S2[] = { 0xbc68,0x487f,0x8385,0x2b4c, 0x3c7e,0x420a,0xa1f5,0x237f, 0x3c99,0x6cad,0x2812,0xee75, 0xbcb8,0x637b,0x457b,0x39af, 0xbccd,0xed01,0xc086,0xedf9, 0x3cf1,0xb791,0x969f,0x9513, 0x3d06,0xea62,0xae46,0xcd11, 0xbd27,0xb518,0xb74a,0x650f, 0xbd46,0xa216,0x216e,0x0713, 0x3d57,0x8db0,0x463a,0x9f2e, 0x3d87,0xfa6a,0x0a69,0x0dd5, 0x3d7d,0x5c47,0xd2cd,0x9397, 0xbdc3,0x33a7,0x1fe6,0xb5d8, 0xbde5,0xcb8f,0x9e19,0xa2da, 0xbde8,0xa42f,0xaf5a,0xe7b9, 0x3e1e,0x48f2,0xb2c4,0xd544, 0x3e52,0x26d1,0x3b1d,0x8488, 0x3e80,0xd46d,0xaf17,0x084c, 0x3eb3,0x8009,0xc871,0x3efc, 0x3ef0,0xe2d6,0x7f39,0xb36e, 0x3f36,0xecd8,0x1f7d,0x73d7, 0x3f8a,0x4ff3,0x66d5,0xb790, 0x3ff0,0x9625,0xe325,0x9d96 }; #endif #ifdef UNK /* x md_exp(-x) chin(x), inverted interval 8 to 18 */ static double C1[] = { -8.12435385225864036372E-18, 2.17586413290339214377E-17, 5.22624394924072204667E-17, -9.48812110591690559363E-16, 5.35546311647465209166E-15, -1.21009970113732918701E-14, -6.00865178553447437951E-14, 7.16339649156028587775E-13, -2.93496072607599856104E-12, -1.40359438136491256904E-12, 8.76302288609054966081E-11, -4.40092476213282340617E-10, -1.87992075640569295479E-10, 1.31458150989474594064E-8, -4.75513930924765465590E-8, -2.21775018801848880741E-7, 1.94635531373272490962E-6, 4.33505889257316408893E-6, -6.13387001076494349496E-5, -3.13085477492997465138E-4, 4.97164789823116062801E-4, 2.64347496031374526641E-2, 1.11446150876699213025E0 }; /* x md_exp(-x) chin(x), inverted interval 18 to 88 */ static double C2[] = { 8.06913408255155572081E-18, -2.08074168180148170312E-17, -5.98111329658272336816E-17, 2.68533951085945765591E-16, 4.52313941698904694774E-16, -3.10734917335299464535E-15, -4.42823207332531972288E-15, 3.49639695410806959872E-14, 6.63406731718911586609E-14, -3.71902448093119218395E-13, -1.27135418132338309016E-12, 2.74851141935315395333E-12, 2.33781843985453438400E-11, 2.71436006377612442764E-11, -2.56600180000355990529E-10, -1.61021375163803438552E-9, -4.72543064876271773512E-9, -3.00095178028681682282E-9, 7.79387474390914922337E-8, 1.06942765566401507066E-6, 1.59503164802313196374E-5, 3.49592575153777996871E-4, 1.28475387530065247392E-2, 1.03665693917934275131E0 }; #endif #ifdef DEC static unsigned short C1[] = { 0122025,0157055,0021702,0021427, 0022310,0130043,0123265,0022340, 0022561,0002231,0017746,0013043, 0123610,0136375,0002352,0024467, 0024300,0171555,0141300,0000446, 0124531,0176777,0126210,0035616, 0125207,0046604,0167760,0077132, 0026111,0120666,0026606,0064143, 0126516,0103615,0054127,0005436, 0126305,0104721,0025415,0004134, 0027700,0131556,0164725,0157553, 0130361,0170602,0077274,0055406, 0130116,0131420,0125472,0017231, 0031541,0153747,0177312,0056304, 0132114,0035517,0041545,0043151, 0132556,0020415,0110044,0172442, 0033402,0117041,0031152,0010364, 0033621,0072737,0050647,0013720, 0134600,0121366,0140010,0063265, 0135244,0022637,0013756,0044742, 0035402,0052052,0006523,0043564, 0036730,0106660,0020277,0162146, 0040216,0123254,0135147,0005724 }; static unsigned short C2[] = { 0022024,0154550,0104311,0144257, 0122277,0165037,0133443,0155601, 0122611,0165102,0157053,0055252, 0023232,0146235,0153511,0113222, 0023402,0057340,0145304,0010471, 0124137,0164171,0113071,0100002, 0124237,0105473,0056130,0022022, 0025035,0073266,0056746,0164433, 0025225,0061313,0055600,0165407, 0125721,0056312,0107613,0051215, 0126262,0166534,0115336,0066653, 0026501,0064307,0127442,0065573, 0027315,0121375,0142020,0045356, 0027356,0140764,0070641,0046570, 0130215,0010503,0146335,0177737, 0130735,0047134,0015215,0163665, 0131242,0056523,0155276,0050053, 0131116,0034515,0050707,0163512, 0032247,0057507,0107545,0032007, 0033217,0104501,0021706,0025047, 0034205,0146413,0033746,0076562, 0035267,0044605,0065355,0002772, 0036522,0077173,0130716,0170304, 0040204,0130454,0130571,0027270 }; #endif #ifdef IBMPC static unsigned short C1[] = { 0x4463,0xa478,0xbbc5,0xbc62, 0xa49c,0x74d6,0x1604,0x3c79, 0xc2c4,0x23fc,0x2093,0x3c8e, 0x4527,0xa09d,0x179f,0xbcd1, 0x0025,0xb858,0x1e6d,0x3cf8, 0x0772,0xf591,0x3fbf,0xbd0b, 0x0fcb,0x9dfe,0xe9b0,0xbd30, 0xcd0c,0xc5b0,0x3436,0x3d69, 0xe164,0xab0a,0xd0f1,0xbd89, 0xa10c,0x2561,0xb13a,0xbd78, 0xbbed,0xdd3a,0x166d,0x3dd8, 0x8b61,0x4fd7,0x3e30,0xbdfe, 0x43d3,0x1567,0xd662,0xbde9, 0x4b98,0xffd9,0x3afc,0x3e4c, 0xa8cd,0xe86c,0x8769,0xbe69, 0x9ea4,0xb204,0xc421,0xbe8d, 0x421f,0x264d,0x53c4,0x3ec0, 0xe2fa,0xea34,0x2ebb,0x3ed2, 0x0cd7,0xd801,0x145e,0xbf10, 0xc93c,0xe2fd,0x84b3,0xbf34, 0x68ef,0x41aa,0x4a85,0x3f40, 0xfc8d,0x0417,0x11b6,0x3f9b, 0xe17b,0x974c,0xd4d5,0x3ff1 }; static unsigned short C2[] = { 0x3916,0x1119,0x9b2d,0x3c62, 0x7b70,0xf6e4,0xfd43,0xbc77, 0x6b55,0x5bc5,0x3d48,0xbc91, 0x32d2,0xbae9,0x5993,0x3cb3, 0x8227,0x1958,0x4bdc,0x3cc0, 0x3000,0x32c7,0xfd0f,0xbceb, 0x0482,0x6b8b,0xf167,0xbcf3, 0xdd23,0xcbbc,0xaed6,0x3d23, 0x1d61,0x6b70,0xac59,0x3d32, 0x6a52,0x51f1,0x2b99,0xbd5a, 0xcdb5,0x935b,0x5dab,0xbd76, 0x4d6f,0xf5e4,0x2d18,0x3d88, 0x095e,0xb882,0xb45f,0x3db9, 0x29af,0x8e34,0xd83e,0x3dbd, 0xbffc,0x799b,0xa228,0xbdf1, 0xbcf7,0x8351,0xa9cb,0xbe1b, 0xca05,0x7b57,0x4baa,0xbe34, 0xfce9,0xaa38,0xc729,0xbe29, 0xa681,0xf1ec,0xebe8,0x3e74, 0xc545,0x2478,0xf128,0x3eb1, 0xcfae,0x66fc,0xb9a1,0x3ef0, 0xa0bf,0xad5d,0xe930,0x3f36, 0xde19,0x7639,0x4fcf,0x3f8a, 0x25d7,0x962f,0x9625,0x3ff0 }; #endif #ifdef MIEEE static unsigned short C1[] = { 0xbc62,0xbbc5,0xa478,0x4463, 0x3c79,0x1604,0x74d6,0xa49c, 0x3c8e,0x2093,0x23fc,0xc2c4, 0xbcd1,0x179f,0xa09d,0x4527, 0x3cf8,0x1e6d,0xb858,0x0025, 0xbd0b,0x3fbf,0xf591,0x0772, 0xbd30,0xe9b0,0x9dfe,0x0fcb, 0x3d69,0x3436,0xc5b0,0xcd0c, 0xbd89,0xd0f1,0xab0a,0xe164, 0xbd78,0xb13a,0x2561,0xa10c, 0x3dd8,0x166d,0xdd3a,0xbbed, 0xbdfe,0x3e30,0x4fd7,0x8b61, 0xbde9,0xd662,0x1567,0x43d3, 0x3e4c,0x3afc,0xffd9,0x4b98, 0xbe69,0x8769,0xe86c,0xa8cd, 0xbe8d,0xc421,0xb204,0x9ea4, 0x3ec0,0x53c4,0x264d,0x421f, 0x3ed2,0x2ebb,0xea34,0xe2fa, 0xbf10,0x145e,0xd801,0x0cd7, 0xbf34,0x84b3,0xe2fd,0xc93c, 0x3f40,0x4a85,0x41aa,0x68ef, 0x3f9b,0x11b6,0x0417,0xfc8d, 0x3ff1,0xd4d5,0x974c,0xe17b }; static unsigned short C2[] = { 0x3c62,0x9b2d,0x1119,0x3916, 0xbc77,0xfd43,0xf6e4,0x7b70, 0xbc91,0x3d48,0x5bc5,0x6b55, 0x3cb3,0x5993,0xbae9,0x32d2, 0x3cc0,0x4bdc,0x1958,0x8227, 0xbceb,0xfd0f,0x32c7,0x3000, 0xbcf3,0xf167,0x6b8b,0x0482, 0x3d23,0xaed6,0xcbbc,0xdd23, 0x3d32,0xac59,0x6b70,0x1d61, 0xbd5a,0x2b99,0x51f1,0x6a52, 0xbd76,0x5dab,0x935b,0xcdb5, 0x3d88,0x2d18,0xf5e4,0x4d6f, 0x3db9,0xb45f,0xb882,0x095e, 0x3dbd,0xd83e,0x8e34,0x29af, 0xbdf1,0xa228,0x799b,0xbffc, 0xbe1b,0xa9cb,0x8351,0xbcf7, 0xbe34,0x4baa,0x7b57,0xca05, 0xbe29,0xc729,0xaa38,0xfce9, 0x3e74,0xebe8,0xf1ec,0xa681, 0x3eb1,0xf128,0x2478,0xc545, 0x3ef0,0xb9a1,0x66fc,0xcfae, 0x3f36,0xe930,0xad5d,0xa0bf, 0x3f8a,0x4fcf,0x7639,0xde19, 0x3ff0,0x9625,0x962f,0x25d7 }; #endif /* Sine and cosine integrals */ #ifdef ANSIPROT extern double md_log ( double ); extern double md_exp ( double ); extern double md_fabs ( double ); extern double chbevl ( double, void *, int ); #else double md_log(), md_exp(), md_fabs(), chbevl(); #endif #define EUL 0.57721566490153286061 extern double MACHEP, MAXNUM, PIO2; int shichi( x, si, ci ) double x; double *si, *ci; { double k, z, c, s, a; short sign; if( x < 0.0 ) { sign = -1; x = -x; } else sign = 0; if( x == 0.0 ) { *si = 0.0; *ci = -MAXNUM; return( 0 ); } if( x >= 8.0 ) goto chb; z = x * x; /* Direct power series expansion */ a = 1.0; s = 1.0; c = 0.0; k = 2.0; do { a *= z/k; c += a/k; k += 1.0; a /= k; s += a/k; k += 1.0; } while( md_fabs(a/s) > MACHEP ); s *= x; goto done; chb: if( x < 18.0 ) { a = (576.0/x - 52.0)/10.0; k = md_exp(x) / x; s = k * chbevl( a, S1, 22 ); c = k * chbevl( a, C1, 23 ); goto done; } if( x <= 88.0 ) { a = (6336.0/x - 212.0)/70.0; k = md_exp(x) / x; s = k * chbevl( a, S2, 23 ); c = k * chbevl( a, C2, 24 ); goto done; } else { if( sign ) *si = -MAXNUM; else *si = MAXNUM; *ci = MAXNUM; return(0); } done: if( sign ) s = -s; *si = s; *ci = EUL + md_log(x) + c; return(0); } Math-Cephes-0.5306/libmd/lrand.c0000644000175000017500000000226214757021403016131 0ustar shlomifshlomif/* lrand.c * * Pseudorandom number generator * * * * SYNOPSIS: * * long y, drand(); * * drand( &y ); * * * * DESCRIPTION: * * Yields a long integer random number. * * The three-generator congruential algorithm by Brian * Wichmann and David Hill (BYTE magazine, March, 1987, * pp 127-8) is used. The period, given by them, is * 6953607871644. * * */ #include "mconf.h" /* Three-generator random number algorithm * of Brian Wichmann and David Hill * BYTE magazine, March, 1987 pp 127-8 * * The period, given by them, is (p-1)(q-1)(r-1)/4 = 6.95e12. */ static int sx = 1; static int sy = 10000; static int sz = 3000; /* This function implements the three * congruential generators. */ long lrand() { int r, s; unsigned long ans; /* if( arg ) { sx = 1; sy = 10000; sz = 3000; } */ /* sx = sx * 171 mod 30269 */ r = sx/177; s = sx - 177 * r; sx = 171 * s - 2 * r; if( sx < 0 ) sx += 30269; /* sy = sy * 172 mod 30307 */ r = sy/176; s = sy - 176 * r; sy = 172 * s - 35 * r; if( sy < 0 ) sy += 30307; /* sz = 170 * sz mod 30323 */ r = sz/178; s = sz - 178 * r; sz = 170 * s - 63 * r; if( sz < 0 ) sz += 30323; ans = sx * sy * sz; return(ans); } Math-Cephes-0.5306/libmd/polyr_wrap.c0000644000175000017500000001407514757021403017234 0ustar shlomifshlomif /* Arithmetic operations on polynomials with rational coefficients * * In the following descriptions a, b, c are polynomials of degree * na, nb, nc respectively. The degree of a polynomial cannot * exceed a run-time value FMAXPOL. An operation that attempts * to use or generate a polynomial of higher degree may produce a * result that suffers truncation at degree FMAXPOL. The value of * FMAXPOL is set by calling the function * * polini( maxpol ); * * where maxpol is the desired maximum degree. This must be * done prior to calling any of the other functions in this module. * Memory for internal temporary polynomial storage is allocated * by polini(). * * Each polynomial is represented by an array containing its * coefficients, together with a separately declared integer equal * to the degree of the polynomial. The coefficients appear in * ascending order; that is, * * 2 na * a(x) = a[0] + a[1] * x + a[2] * x + ... + a[na] * x . * * wrapper functions to the following: * * `a', `b', `c' are arrays of fracts. * fpoleva( a, na, &x, &sum ); Evaluate polynomial a(t) at t = x. * fpoladd( a, na, b, nb, c ); c = b + a, nc = max(na,nb) * fpolsub( a, na, b, nb, c ); c = b - a, nc = max(na,nb) * fpolmul( a, na, b, nb, c ); c = b * a, nc = na+nb * * * Division: * * i = fpoldiv( a, na, b, nb, c ); c = b / a, nc = FMAXPOL * * returns i = the degree of the first nonzero coefficient of a. * The computed quotient c must be divided by x^i. An error message * is printed if a is identically zero. * * * Change of variables: * If a and b are polynomials, and t = a(x), then * c(t) = b(a(x)) * is a polynomial found by substituting a(x) for t. The * subroutine call for this is * * fpolsbt( a, na, b, nb, c ); * * * Notes: * fpoldiv() is an integer routine; fpoleva() is double. * Any of the arguments a, b, c may refer to the same array. * */ #include #include "mconf.h" #ifndef NULL #define NULL 0 #endif typedef struct{ double n; double d; }fract; #ifdef ANSIPROT extern void * malloc ( long ); extern void free ( void * ); #else void * malloc(); void free (); #endif int FMAXPOL = 0; extern int FMAXPOL; void fpoladd_wrap( an, ad, na, bn, bd, nb, cn, cd, nc) double an[], ad[], bn[], bd[], cn[], cd[]; int na, nb, nc; { extern void fpoladd( fract a[], int na, fract b[], int nb, fract c[]); fract *a, *b, *c; int j; a = (fract *) malloc( (na+1) * sizeof (fract) ); b = (fract *) malloc( (nb+1) * sizeof (fract) ); c = (fract *) malloc( (nc+1) * sizeof (fract) ); for (j=0; j<=na; j++) { a[j].n = an[j]; a[j].d = ad[j]; } for (j=0; j<=nb; j++) { b[j].n = bn[j]; b[j].d = bd[j]; } for (j=0; j<=nc; j++) { c[j].n = 0; c[j].d = 1; } fpoladd(a, na, b, nb, c); for (j=0; j<=nc; j++) { cn[j] = c[j].n; cd[j] = c[j].d; } free(a); free(b); free(c); } void fpolsub_wrap( an, ad, na, bn, bd, nb, cn, cd, nc) double an[], ad[], bn[], bd[], cn[], cd[]; int na, nb, nc; { extern void fpolsub( fract a[], int na, fract b[], int nb, fract c[]); fract *a, *b, *c; int j; a = (fract *) malloc( (na+1) * sizeof (fract) ); b = (fract *) malloc( (nb+1) * sizeof (fract) ); c = (fract *) malloc( (nc+1) * sizeof (fract) ); for (j=0; j<=na; j++) { a[j].n = an[j]; a[j].d = ad[j]; } for (j=0; j<=nb; j++) { b[j].n = bn[j]; b[j].d = bd[j]; } for (j=0; j<=nc; j++) { c[j].n = 0; c[j].d = 1; } fpolsub(a, na, b, nb, c); for (j=0; j<=nc; j++) { cn[j] = c[j].n; cd[j] = c[j].d; } free(a); free(b); free(c); } void fpolmul_wrap( an, ad, na, bn, bd, nb, cn, cd, nc) double an[], ad[], bn[], bd[], cn[], cd[]; int na, nb, nc; { extern void fpolmul( fract a[], int na, fract b[], int nb, fract c[]); fract *a, *b, *c; int j; a = (fract *) malloc( (na+1) * sizeof (fract) ); b = (fract *) malloc( (nb+1) * sizeof (fract) ); c = (fract *) malloc( (nc+1) * sizeof (fract) ); for (j=0; j<=na; j++) { a[j].n = an[j]; a[j].d = ad[j]; } for (j=0; j<=nb; j++) { b[j].n = bn[j]; b[j].d = bd[j]; } for (j=0; j<=nc; j++) { c[j].n = 0; c[j].d = 1; } fpolmul(a, na, b, nb, c); for (j=0; j<=nc; j++) { cn[j] = c[j].n; cd[j] = c[j].d; } free(a); free(b); free(c); } int fpoldiv_wrap( an, ad, na, bn, bd, nb, cn, cd, nc) double an[], ad[], bn[], bd[], cn[], cd[]; int na, nb, nc; { extern int fpoldiv( fract a[], int na, fract b[], int nb, fract c[]); fract *a, *b, *c; int j, ret; a = (fract *) malloc( (na+1) * sizeof (fract) ); b = (fract *) malloc( (nb+1) * sizeof (fract) ); c = (fract *) malloc( (nc+1) * sizeof (fract) ); for (j=0; j<=na; j++) { a[j].n = an[j]; a[j].d = ad[j]; } for (j=0; j<=nb; j++) { b[j].n = bn[j]; b[j].d = bd[j]; } for (j=0; j<=nc; j++) { c[j].n = 0; c[j].d = 1; } ret = fpoldiv(a, na, b, nb, c); for (j=0; j<=nc; j++) { cn[j] = c[j].n; cd[j] = c[j].d; } free(a); free(b); free(c); return ret; } void fpoleva_wrap( an, ad, na, x, s) double an[], ad[]; int na; fract *x, *s; { extern void fpoleva( fract a[], int na, fract *x, fract *s); fract *a; int j; a = (fract *) malloc( (na+1) * sizeof (fract) ); for (j=0; j<=na; j++) { a[j].n = an[j]; a[j].d = ad[j]; } s->n = 0.0; s->d = 1.0; fpoleva(a, na, x, s); free(a); } void fpolsbt_wrap( an, ad, na, bn, bd, nb, cn, cd, nc) double an[], ad[], bn[], bd[], cn[], cd[]; int na, nb, nc; { extern void fpolsbt( fract a[], int na, fract b[], int nb, fract c[]); fract *a, *b, *c; int j; a = (fract *) malloc( (na+1) * sizeof (fract) ); b = (fract *) malloc( (nb+1) * sizeof (fract) ); c = (fract *) malloc( (nc+1) * sizeof (fract) ); for (j=0; j<=na; j++) { a[j].n = an[j]; a[j].d = ad[j]; } for (j=0; j<=nb; j++) { b[j].n = bn[j]; b[j].d = bd[j]; } for (j=0; j<=nc; j++) { c[j].n = 0; c[j].d = 1; } fpolsbt(a, na, b, nb, c); for (j=0; j<=nc; j++) { cn[j] = c[j].n; cd[j] = c[j].d; } free(a); free(b); free(c); } Math-Cephes-0.5306/libmd/iv.c0000644000175000017500000000443114757021403015447 0ustar shlomifshlomif/* iv.c * * Modified Bessel function of noninteger order * * * * SYNOPSIS: * * double v, x, y, iv(); * * y = iv( v, x ); * * * * DESCRIPTION: * * Returns modified Bessel function of order v of the * argument. If x is negative, v must be integer valued. * * The function is defined as Iv(x) = Jv( ix ). It is * here computed in terms of the confluent hypergeometric * function, according to the formula * * v -x * Iv(x) = (x/2) e hyperg( v+0.5, 2v+1, 2x ) / md_gamma(v+1) * * If v is a negative integer, then v is replaced by -v. * * * ACCURACY: * * Tested at random points (v, x), with v between 0 and * 30, x between 0 and 28. * Relative error: * arithmetic domain # trials peak rms * DEC 0,30 2000 3.1e-15 5.4e-16 * IEEE 0,30 10000 1.7e-14 2.7e-15 * * Accuracy is diminished if v is near a negative integer. * * See also hyperg.c. * */ /* iv.c */ /* Modified Bessel function of noninteger order */ /* If x < 0, then v must be an integer. */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double hyperg ( double, double, double ); extern double md_exp ( double ); extern double md_gamma ( double ); extern double md_log ( double ); extern double md_fabs ( double ); extern double md_floor ( double ); #else double hyperg(), md_exp(), md_gamma(), md_log(), md_fabs(), md_floor(); #endif extern double MACHEP, MAXNUM; double iv( v, x ) double v, x; { int sign; double t, ax; /* If v is a negative integer, invoke symmetry */ t = md_floor(v); if( v < 0.0 ) { if( t == v ) { v = -v; /* symmetry */ t = -t; } } /* If x is negative, require v to be an integer */ sign = 1; if( x < 0.0 ) { if( t != v ) { mtherr( "iv", DOMAIN ); return( 0.0 ); } if( v != 2.0 * md_floor(v/2.0) ) sign = -1; } /* Avoid logarithm singularity */ if( x == 0.0 ) { if( v == 0.0 ) return( 1.0 ); if( v < 0.0 ) { mtherr( "iv", OVERFLOW ); return( MAXNUM ); } else return( 0.0 ); } ax = md_fabs(x); t = v * md_log( 0.5 * ax ) - x; t = sign * md_exp(t) / md_gamma( v + 1.0 ); ax = v + 0.5; return( t * hyperg( ax, 2.0 * ax, 2.0 * x ) ); } Math-Cephes-0.5306/libmd/rgamma.c0000644000175000017500000001115014757021403016271 0ustar shlomifshlomif/* rgamma.c * * Reciprocal md_gamma function * * * * SYNOPSIS: * * double x, y, rgamma(); * * y = rgamma( x ); * * * * DESCRIPTION: * * Returns one divided by the md_gamma function of the argument. * * The function is approximated by a Chebyshev expansion in * the interval [0,1]. Range reduction is by recurrence * for arguments between -34.034 and +34.84425627277176174. * 1/MAXNUM is returned for positive arguments outside this * range. For arguments less than -34.034 the cosecant * reflection formula is applied; lograrithms are employed * to avoid unnecessary overflow. * * The reciprocal md_gamma function has no singularities, * but overflow and underflow may occur for large arguments. * These conditions return either MAXNUM or 1/MAXNUM with * appropriate sign. * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -30,+30 4000 1.2e-16 1.8e-17 * IEEE -30,+30 30000 1.1e-15 2.0e-16 * For arguments less than -34.034 the peak error is on the * order of 5e-15 (DEC), excepting overflow or underflow. */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1985, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" /* Chebyshev coefficients for reciprocal md_gamma function * in interval 0 to 1. Function is 1/(x md_gamma(x)) - 1 */ #ifdef UNK static double R[] = { 3.13173458231230000000E-17, -6.70718606477908000000E-16, 2.20039078172259550000E-15, 2.47691630348254132600E-13, -6.60074100411295197440E-12, 5.13850186324226978840E-11, 1.08965386454418662084E-9, -3.33964630686836942556E-8, 2.68975996440595483619E-7, 2.96001177518801696639E-6, -8.04814124978471142852E-5, 4.16609138709688864714E-4, 5.06579864028608725080E-3, -6.41925436109158228810E-2, -4.98558728684003594785E-3, 1.27546015610523951063E-1 }; #endif #ifdef DEC static unsigned short R[] = { 0022420,0066376,0176751,0071636, 0123501,0051114,0042104,0131153, 0024036,0107013,0126504,0033361, 0025613,0070040,0035174,0162316, 0126750,0037060,0077775,0122202, 0027541,0177143,0037675,0105150, 0030625,0141311,0075005,0115436, 0132017,0067714,0125033,0014721, 0032620,0063707,0105256,0152643, 0033506,0122235,0072757,0170053, 0134650,0144041,0015617,0016143, 0035332,0066125,0000776,0006215, 0036245,0177377,0137173,0131432, 0137203,0073541,0055645,0141150, 0136243,0057043,0026226,0017362, 0037402,0115554,0033441,0012310 }; #endif #ifdef IBMPC static unsigned short R[] = { 0x2e74,0xdfbd,0x0d9f,0x3c82, 0x964d,0x8888,0x2a49,0xbcc8, 0x86de,0x75a8,0xd1c1,0x3ce3, 0x9c9a,0x074f,0x6e04,0x3d51, 0xb490,0x0fff,0x07c6,0xbd9d, 0xb14d,0x67f7,0x3fcc,0x3dcc, 0xb364,0x2f40,0xb859,0x3e12, 0x633a,0x9543,0xedf9,0xbe61, 0xdab4,0xf155,0x0cf8,0x3e92, 0xfe05,0xaebd,0xd493,0x3ec8, 0xe38c,0x2371,0x1904,0xbf15, 0xc192,0xa03f,0x4d8a,0x3f3b, 0x7663,0xf7cf,0xbfdf,0x3f74, 0xb84d,0x2b74,0x6eec,0xbfb0, 0xc3de,0x6592,0x6bc4,0xbf74, 0x2299,0x86e4,0x536d,0x3fc0 }; #endif #ifdef MIEEE static unsigned short R[] = { 0x3c82,0x0d9f,0xdfbd,0x2e74, 0xbcc8,0x2a49,0x8888,0x964d, 0x3ce3,0xd1c1,0x75a8,0x86de, 0x3d51,0x6e04,0x074f,0x9c9a, 0xbd9d,0x07c6,0x0fff,0xb490, 0x3dcc,0x3fcc,0x67f7,0xb14d, 0x3e12,0xb859,0x2f40,0xb364, 0xbe61,0xedf9,0x9543,0x633a, 0x3e92,0x0cf8,0xf155,0xdab4, 0x3ec8,0xd493,0xaebd,0xfe05, 0xbf15,0x1904,0x2371,0xe38c, 0x3f3b,0x4d8a,0xa03f,0xc192, 0x3f74,0xbfdf,0xf7cf,0x7663, 0xbfb0,0x6eec,0x2b74,0xb84d, 0xbf74,0x6bc4,0x6592,0xc3de, 0x3fc0,0x536d,0x86e4,0x2299 }; #endif static char name[] = "rgamma"; #ifdef ANSIPROT extern double chbevl ( double, void *, int ); extern double md_exp ( double ); extern double md_log ( double ); extern double md_sin ( double ); extern double lgam ( double ); #else double chbevl(), md_exp(), md_log(), md_sin(), lgam(); #endif extern double PI, MAXLOG, MAXNUM; double rgamma(x) double x; { double w, y, z; int sign; if( x > 34.84425627277176174) { mtherr( name, UNDERFLOW ); return(1.0/MAXNUM); } if( x < -34.034 ) { w = -x; z = md_sin( PI*w ); if( z == 0.0 ) return(0.0); if( z < 0.0 ) { sign = 1; z = -z; } else sign = -1; y = md_log( w * z ) - md_log(PI) + lgam(w); if( y < -MAXLOG ) { mtherr( name, UNDERFLOW ); return( sign * 1.0 / MAXNUM ); } if( y > MAXLOG ) { mtherr( name, OVERFLOW ); return( sign * MAXNUM ); } return( sign * md_exp(y)); } z = 1.0; w = x; while( w > 1.0 ) /* Downward recurrence */ { w -= 1.0; z *= w; } while( w < 0.0 ) /* Upward recurrence */ { z /= w; w += 1.0; } if( w == 0.0 ) /* Nonpositive integer */ return(0.0); if( w == 1.0 ) /* Other integer */ return( 1.0/z ); y = w * ( 1.0 + chbevl( 4.0*w-2.0, R, 16 ) ) / z; return(y); } Math-Cephes-0.5306/libmd/setprelf.3870000644000175000017500000000204714757021403016755 0ustar shlomifshlomif/* Set 80387 floating point hardware rounding precision */ .file "setprec.387" .version "01.01" .text .align 16 .globl sprec sprec: pushl %ebp movl %esp,%ebp pushl %eax subl $4,%esp fstcw (%esp) fwait movl (%esp),%eax andl $0xfcff,%eax movl %eax,(%esp) fldcw (%esp) popl %eax popl %eax leave ret .Lfe1: .size sprec,.Lfe1-sprec .align 16 .globl dprec dprec: pushl %ebp movl %esp,%ebp pushl %eax subl $4,%esp fstcw (%esp) fwait movl (%esp),%eax andl $0xfcff,%eax /* trap on overflow */ /* andl $0xfcf7,%eax */ orl $0x200,%eax movl %eax,(%esp) fldcw (%esp) popl %eax popl %eax leave ret .Lfe2: .size dprec,.Lfe2-dprec .align 16 .globl ldprec ldprec: pushl %ebp movl %esp,%ebp pushl %eax subl $4,%esp fstcw (%esp) fwait movl (%esp),%eax orl $0x300,%eax movl %eax,(%esp) fldcw (%esp) popl %eax popl %eax leave ret .Lfe3: .size ldprec,.Lfe3-ldprec .align 16 .globl getprec getprec: pushl %ebp movl %esp,%ebp subl $4,%esp fstcw (%esp) fwait movl (%esp),%eax leave ret .Lfe4: .size getprec,.Lfe4-getprec Math-Cephes-0.5306/libmd/clog.c0000644000175000017500000004116014757021403015755 0ustar shlomifshlomif/* md_clog.c * * Complex natural logarithm * * * * SYNOPSIS: * * void md_clog(); * cmplx z, w; * * md_clog( &z, &w ); * * * * DESCRIPTION: * * Returns complex logarithm to the base e (2.718...) of * the complex argument x. * * If z = x + iy, r = sqrt( x**2 + y**2 ), * then * w = md_log(r) + i arctan(y/x). * * The arctangent ranges from -PI to +PI. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 7000 8.5e-17 1.9e-17 * IEEE -10,+10 30000 5.0e-15 1.1e-16 * * Larger relative error can be observed for z near 1 +i0. * In IEEE arithmetic the peak absolute error is 5.2e-16, rms * absolute error 1.0e-16. */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT static void cchsh ( double x, double *c, double *s ); static double redupi ( double x ); static double ctans ( cmplx *z ); /* These are supposed to be in some standard place. */ double md_fabs (double); double sqrt (double); double md_pow (double, double); double md_log (double); double md_exp (double); double md_atan2 (double, double); double md_cosh (double); double md_sinh (double); double md_asin (double); double md_sin (double); double md_cos (double); double md_cabs (cmplx *); void cadd ( cmplx *, cmplx *, cmplx * ); void cmul ( cmplx *, cmplx *, cmplx * ); void md_csqrt ( cmplx *, cmplx * ); static void cchsh ( double, double *, double * ); static double redupi ( double ); static double ctans ( cmplx * ); void md_clog ( cmplx *, cmplx * ); void md_casin ( cmplx *, cmplx * ); void md_cacos ( cmplx *, cmplx * ); void md_catan ( cmplx *, cmplx * ); #else static void cchsh(); static double redupi(); static double ctans(); double md_cabs(), md_fabs(), sqrt(), md_pow(); double md_log(), md_exp(), md_atan2(), md_cosh(), md_sinh(); double md_asin(), md_sin(), md_cos(); void cadd(), cmul(), md_csqrt(); void md_clog(), md_casin(), md_cacos(), md_catan(); #endif extern double MAXNUM, MACHEP, PI, PIO2; void md_clog( z, w ) register cmplx *z, *w; { double p, rr; /*rr = sqrt( z->r * z->r + z->i * z->i );*/ rr = md_cabs(z); p = md_log(rr); #if ANSIC rr = md_atan2( z->i, z->r ); #else rr = md_atan2( z->r, z->i ); if( rr > PI ) rr -= PI + PI; #endif w->i = rr; w->r = p; } /* md_cexp() * * Complex exponential function * * * * SYNOPSIS: * * void md_cexp(); * cmplx z, w; * * md_cexp( &z, &w ); * * * * DESCRIPTION: * * Returns the exponential of the complex argument z * into the complex result w. * * If * z = x + iy, * r = md_exp(x), * * then * * w = r md_cos y + i r md_sin y. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 8700 3.7e-17 1.1e-17 * IEEE -10,+10 30000 3.0e-16 8.7e-17 * */ void md_cexp( z, w ) register cmplx *z, *w; { double r; r = md_exp( z->r ); w->r = r * md_cos( z->i ); w->i = r * md_sin( z->i ); } /* md_csin() * * Complex circular sine * * * * SYNOPSIS: * * void md_csin(); * cmplx z, w; * * md_csin( &z, &w ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * w = md_sin x md_cosh y + i md_cos x md_sinh y. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 8400 5.3e-17 1.3e-17 * IEEE -10,+10 30000 3.8e-16 1.0e-16 * Also tested by md_csin(md_casin(z)) = z. * */ void md_csin( z, w ) register cmplx *z, *w; { double ch, sh; cchsh( z->i, &ch, &sh ); w->r = md_sin( z->r ) * ch; w->i = md_cos( z->r ) * sh; } /* calculate md_cosh and md_sinh */ static void cchsh( x, c, s ) double x, *c, *s; { double e, ei; if( md_fabs(x) <= 0.5 ) { *c = md_cosh(x); *s = md_sinh(x); } else { e = md_exp(x); ei = 0.5/e; e = 0.5 * e; *s = e - ei; *c = e + ei; } } /* md_ccos() * * Complex circular cosine * * * * SYNOPSIS: * * void md_ccos(); * cmplx z, w; * * md_ccos( &z, &w ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * w = md_cos x md_cosh y - i md_sin x md_sinh y. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 8400 4.5e-17 1.3e-17 * IEEE -10,+10 30000 3.8e-16 1.0e-16 */ void md_ccos( z, w ) register cmplx *z, *w; { double ch, sh; cchsh( z->i, &ch, &sh ); w->r = md_cos( z->r ) * ch; w->i = -md_sin( z->r ) * sh; } /* md_ctan() * * Complex circular tangent * * * * SYNOPSIS: * * void md_ctan(); * cmplx z, w; * * md_ctan( &z, &w ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * md_sin 2x + i md_sinh 2y * w = --------------------. * md_cos 2x + md_cosh 2y * * On the real axis the denominator is zero at odd multiples * of PI/2. The denominator is evaluated by its Taylor * series near these points. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 5200 7.1e-17 1.6e-17 * IEEE -10,+10 30000 7.2e-16 1.2e-16 * Also tested by md_ctan * ccot = 1 and md_catan(md_ctan(z)) = z. */ void md_ctan( z, w ) register cmplx *z, *w; { double d; d = md_cos( 2.0 * z->r ) + md_cosh( 2.0 * z->i ); if( md_fabs(d) < 0.25 ) d = ctans(z); if( d == 0.0 ) { mtherr( "md_ctan", OVERFLOW ); w->r = MAXNUM; w->i = MAXNUM; return; } w->r = md_sin( 2.0 * z->r ) / d; w->i = md_sinh( 2.0 * z->i ) / d; } /* ccot() * * Complex circular cotangent * * * * SYNOPSIS: * * void ccot(); * cmplx z, w; * * ccot( &z, &w ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * * md_sin 2x - i md_sinh 2y * w = --------------------. * md_cosh 2y - md_cos 2x * * On the real axis, the denominator has zeros at even * multiples of PI/2. Near these points it is evaluated * by a Taylor series. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 3000 6.5e-17 1.6e-17 * IEEE -10,+10 30000 9.2e-16 1.2e-16 * Also tested by md_ctan * ccot = 1 + i0. */ void ccot( z, w ) register cmplx *z, *w; { double d; d = md_cosh(2.0 * z->i) - md_cos(2.0 * z->r); if( md_fabs(d) < 0.25 ) d = ctans(z); if( d == 0.0 ) { mtherr( "ccot", OVERFLOW ); w->r = MAXNUM; w->i = MAXNUM; return; } w->r = md_sin( 2.0 * z->r ) / d; w->i = -md_sinh( 2.0 * z->i ) / d; } /* Program to subtract nearest integer multiple of PI */ /* extended precision value of PI: */ #ifdef UNK static double DP1 = 3.14159265160560607910E0; static double DP2 = 1.98418714791870343106E-9; static double DP3 = 1.14423774522196636802E-17; #endif #ifdef DEC static unsigned short P1[] = {0040511,0007732,0120000,0000000,}; static unsigned short P2[] = {0031010,0055060,0100000,0000000,}; static unsigned short P3[] = {0022123,0011431,0105056,0001560,}; #define DP1 *(double *)P1 #define DP2 *(double *)P2 #define DP3 *(double *)P3 #endif #ifdef IBMPC static unsigned short P1[] = {0x0000,0x5400,0x21fb,0x4009}; static unsigned short P2[] = {0x0000,0x1000,0x0b46,0x3e21}; static unsigned short P3[] = {0xc06e,0x3145,0x6263,0x3c6a}; #define DP1 *(double *)P1 #define DP2 *(double *)P2 #define DP3 *(double *)P3 #endif #ifdef MIEEE static unsigned short P1[] = { 0x4009,0x21fb,0x5400,0x0000 }; static unsigned short P2[] = { 0x3e21,0x0b46,0x1000,0x0000 }; static unsigned short P3[] = { 0x3c6a,0x6263,0x3145,0xc06e }; #define DP1 *(double *)P1 #define DP2 *(double *)P2 #define DP3 *(double *)P3 #endif static double redupi(x) double x; { double t; long i; t = x/PI; if( t >= 0.0 ) t += 0.5; else t -= 0.5; i = t; /* the multiple */ t = i; t = ((x - t * DP1) - t * DP2) - t * DP3; return(t); } /* Taylor series expansion for md_cosh(2y) - md_cos(2x) */ static double ctans(z) cmplx *z; { double f, x, x2, y, y2, rn, t; double d; x = md_fabs( 2.0 * z->r ); y = md_fabs( 2.0 * z->i ); x = redupi(x); x = x * x; y = y * y; x2 = 1.0; y2 = 1.0; f = 1.0; rn = 0.0; d = 0.0; do { rn += 1.0; f *= rn; rn += 1.0; f *= rn; x2 *= x; y2 *= y; t = y2 + x2; t /= f; d += t; rn += 1.0; f *= rn; rn += 1.0; f *= rn; x2 *= x; y2 *= y; t = y2 - x2; t /= f; d += t; } while( md_fabs(t/d) > MACHEP ); return(d); } /* md_casin() * * Complex circular arc sine * * * * SYNOPSIS: * * void md_casin(); * cmplx z, w; * * md_casin( &z, &w ); * * * * DESCRIPTION: * * Inverse complex sine: * * 2 * w = -i md_clog( iz + md_csqrt( 1 - z ) ). * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 10100 2.1e-15 3.4e-16 * IEEE -10,+10 30000 2.2e-14 2.7e-15 * Larger relative error can be observed for z near zero. * Also tested by md_csin(md_casin(z)) = z. */ void md_casin( z, w ) cmplx *z, *w; { static cmplx ca, ct, zz, z2; double x, y; x = z->r; y = z->i; if( y == 0.0 ) { if( md_fabs(x) > 1.0 ) { w->r = PIO2; w->i = 0.0; mtherr( "md_casin", DOMAIN ); } else { w->r = md_asin(x); w->i = 0.0; } return; } /* Power series expansion */ /* b = md_cabs(z); if( b < 0.125 ) { z2.r = (x - y) * (x + y); z2.i = 2.0 * x * y; cn = 1.0; n = 1.0; ca.r = x; ca.i = y; sum.r = x; sum.i = y; do { ct.r = z2.r * ca.r - z2.i * ca.i; ct.i = z2.r * ca.i + z2.i * ca.r; ca.r = ct.r; ca.i = ct.i; cn *= n; n += 1.0; cn /= n; n += 1.0; b = cn/n; ct.r *= b; ct.i *= b; sum.r += ct.r; sum.i += ct.i; b = md_fabs(ct.r) + md_fabs(ct.i); } while( b > MACHEP ); w->r = sum.r; w->i = sum.i; return; } */ ca.r = x; ca.i = y; ct.r = -ca.i; /* iz */ ct.i = ca.r; /* sqrt( 1 - z*z) */ /* cmul( &ca, &ca, &zz ) */ zz.r = (ca.r - ca.i) * (ca.r + ca.i); /*x * x - y * y */ zz.i = 2.0 * ca.r * ca.i; zz.r = 1.0 - zz.r; zz.i = -zz.i; md_csqrt( &zz, &z2 ); cadd( &z2, &ct, &zz ); md_clog( &zz, &zz ); w->r = zz.i; /* mult by 1/i = -i */ w->i = -zz.r; return; } /* md_cacos() * * Complex circular arc cosine * * * * SYNOPSIS: * * void md_cacos(); * cmplx z, w; * * md_cacos( &z, &w ); * * * * DESCRIPTION: * * * w = arccos z = PI/2 - arcsin z. * * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 5200 1.6e-15 2.8e-16 * IEEE -10,+10 30000 1.8e-14 2.2e-15 */ void md_cacos( z, w ) cmplx *z, *w; { md_casin( z, w ); w->r = PIO2 - w->r; w->i = -w->i; } /* md_catan() * * Complex circular arc tangent * * * * SYNOPSIS: * * void md_catan(); * cmplx z, w; * * md_catan( &z, &w ); * * * * DESCRIPTION: * * If * z = x + iy, * * then * 1 ( 2x ) * Re w = - arctan(-----------) + k PI * 2 ( 2 2) * (1 - x - y ) * * ( 2 2) * 1 (x + (y+1) ) * Im w = - md_log(------------) * 4 ( 2 2) * (x + (y-1) ) * * Where k is an arbitrary integer. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10,+10 5900 1.3e-16 7.8e-18 * IEEE -10,+10 30000 2.3e-15 8.5e-17 * The check md_catan( md_ctan(z) ) = z, with |x| and |y| < PI/2, * had peak relative error 1.5e-16, rms relative error * 2.9e-17. See also md_clog(). */ void md_catan( z, w ) cmplx *z, *w; { double a, t, x, x2, y; x = z->r; y = z->i; if( (x == 0.0) && (y > 1.0) ) goto ovrf; x2 = x * x; a = 1.0 - x2 - (y * y); if( a == 0.0 ) goto ovrf; #if ANSIC t = md_atan2( 2.0 * x, a )/2.0; #else t = md_atan2( a, 2.0 * x )/2.0; #endif w->r = redupi( t ); t = y - 1.0; a = x2 + (t * t); if( a == 0.0 ) goto ovrf; t = y + 1.0; a = (x2 + (t * t))/a; w->i = md_log(a)/4.0; return; ovrf: mtherr( "md_catan", OVERFLOW ); w->r = MAXNUM; w->i = MAXNUM; } /* md_csinh * * Complex hyperbolic sine * * * * SYNOPSIS: * * void md_csinh(); * cmplx z, w; * * md_csinh( &z, &w ); * * * DESCRIPTION: * * md_csinh z = (md_cexp(z) - md_cexp(-z))/2 * = md_sinh x * md_cos y + i md_cosh x * md_sin y . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 3.1e-16 8.2e-17 * */ void md_csinh (z, w) cmplx *z, *w; { double x, y; x = z->r; y = z->i; w->r = md_sinh (x) * md_cos (y); w->i = md_cosh (x) * md_sin (y); } /* md_casinh * * Complex inverse hyperbolic sine * * * * SYNOPSIS: * * void md_casinh(); * cmplx z, w; * * md_casinh (&z, &w); * * * * DESCRIPTION: * * md_casinh z = -i md_casin iz . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.8e-14 2.6e-15 * */ void md_casinh (z, w) cmplx *z, *w; { cmplx u; u.r = 0.0; u.i = 1.0; cmul( z, &u, &u ); md_casin( &u, w ); u.r = 0.0; u.i = -1.0; cmul( &u, w, w ); } /* md_ccosh * * Complex hyperbolic cosine * * * * SYNOPSIS: * * void md_ccosh(); * cmplx z, w; * * md_ccosh (&z, &w); * * * * DESCRIPTION: * * md_ccosh(z) = md_cosh x md_cos y + i md_sinh x md_sin y . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 2.9e-16 8.1e-17 * */ void md_ccosh (z, w) cmplx *z, *w; { double x, y; x = z->r; y = z->i; w->r = md_cosh (x) * md_cos (y); w->i = md_sinh (x) * md_sin (y); } /* md_cacosh * * Complex inverse hyperbolic cosine * * * * SYNOPSIS: * * void md_cacosh(); * cmplx z, w; * * md_cacosh (&z, &w); * * * * DESCRIPTION: * * md_acosh z = i md_acos z . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.6e-14 2.1e-15 * */ void md_cacosh (z, w) cmplx *z, *w; { cmplx u; md_cacos( z, w ); u.r = 0.0; u.i = 1.0; cmul( &u, w, w ); } /* md_ctanh * * Complex hyperbolic tangent * * * * SYNOPSIS: * * void md_ctanh(); * cmplx z, w; * * md_ctanh (&z, &w); * * * * DESCRIPTION: * * md_tanh z = (md_sinh 2x + i md_sin 2y) / (md_cosh 2x + md_cos 2y) . * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 1.7e-14 2.4e-16 * */ /* 5.253E-02,1.550E+00 1.643E+01,6.553E+00 1.729E-14 21355 */ void md_ctanh (z, w) cmplx *z, *w; { double x, y, d; x = z->r; y = z->i; d = md_cosh (2.0 * x) + md_cos (2.0 * y); w->r = md_sinh (2.0 * x) / d; w->i = md_sin (2.0 * y) / d; return; } /* md_catanh * * Complex inverse hyperbolic tangent * * * * SYNOPSIS: * * void md_catanh(); * cmplx z, w; * * md_catanh (&z, &w); * * * * DESCRIPTION: * * Inverse md_tanh, equal to -i md_catan (iz); * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 2.3e-16 6.2e-17 * */ void md_catanh (z, w) cmplx *z, *w; { cmplx u; u.r = 0.0; u.i = 1.0; cmul (z, &u, &u); /* i z */ md_catan (&u, w); u.r = 0.0; u.i = -1.0; cmul (&u, w, w); /* -i md_catan iz */ return; } /* md_cpow * * Complex power function * * * * SYNOPSIS: * * void md_cpow(); * cmplx a, z, w; * * md_cpow (&a, &z, &w); * * * * DESCRIPTION: * * Raises complex A to the complex Zth power. * Definition is per AMS55 # 4.2.8, * analytically equivalent to md_cpow(a,z) = md_cexp(z md_clog(a)). * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10,+10 30000 9.4e-15 1.5e-15 * */ void md_cpow (a, z, w) cmplx *a, *z, *w; { double x, y, r, theta, absa, arga; x = z->r; y = z->i; absa = md_cabs (a); if (absa == 0.0) { w->r = 0.0; w->i = 0.0; return; } arga = md_atan2 (a->i, a->r); r = md_pow (absa, x); theta = x * arga; if (y != 0.0) { r = r * md_exp (-y * arga); theta = theta + y * md_log (absa); } w->r = r * md_cos (theta); w->i = r * md_sin (theta); return; } Math-Cephes-0.5306/libmd/asin.c0000644000175000017500000001454714757021403015774 0ustar shlomifshlomif/* md_asin.c * * Inverse circular sine * * * * SYNOPSIS: * * double x, y, md_asin(); * * y = md_asin( x ); * * * * DESCRIPTION: * * Returns radian angle between -pi/2 and +pi/2 whose sine is x. * * A rational function of the form x + x**3 P(x**2)/Q(x**2) * is used for |x| in the interval [0, 0.5]. If |x| > 0.5 it is * transformed by the identity * * md_asin(x) = pi/2 - 2 md_asin( sqrt( (1-x)/2 ) ). * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -1, 1 40000 2.6e-17 7.1e-18 * IEEE -1, 1 10^6 1.9e-16 5.4e-17 * * * ERROR MESSAGES: * * message condition value returned * md_asin domain |x| > 1 NAN * */ /* md_acos() * * Inverse circular cosine * * * * SYNOPSIS: * * double x, y, md_acos(); * * y = md_acos( x ); * * * * DESCRIPTION: * * Returns radian angle between 0 and pi whose cosine * is x. * * Analytically, md_acos(x) = pi/2 - md_asin(x). However if |x| is * near 1, there is cancellation error in subtracting md_asin(x) * from pi/2. Hence if x < -0.5, * * md_acos(x) = pi - 2.0 * md_asin( sqrt((1+x)/2) ); * * or if x > +0.5, * * md_acos(x) = 2.0 * md_asin( sqrt((1-x)/2) ). * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -1, 1 50000 3.3e-17 8.2e-18 * IEEE -1, 1 10^6 2.2e-16 6.5e-17 * * * ERROR MESSAGES: * * message condition value returned * md_asin domain |x| > 1 NAN */ /* md_asin.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" /* arcsin(x) = x + x^3 P(x^2)/Q(x^2) 0 <= x <= 0.625 Peak relative error = 1.2e-18 */ #if UNK static double P[6] = { 4.253011369004428248960E-3, -6.019598008014123785661E-1, 5.444622390564711410273E0, -1.626247967210700244449E1, 1.956261983317594739197E1, -8.198089802484824371615E0, }; static double Q[5] = { /* 1.000000000000000000000E0, */ -1.474091372988853791896E1, 7.049610280856842141659E1, -1.471791292232726029859E2, 1.395105614657485689735E2, -4.918853881490881290097E1, }; #endif #if DEC static short P[24] = { 0036213,0056330,0057244,0053234, 0140032,0015011,0114762,0160255, 0040656,0035130,0136121,0067313, 0141202,0014616,0170474,0101731, 0041234,0100076,0151674,0111310, 0141003,0025540,0033165,0077246, }; static short Q[20] = { /* 0040200,0000000,0000000,0000000, */ 0141153,0155310,0055360,0072530, 0041614,0177001,0027764,0101237, 0142023,0026733,0064653,0133266, 0042013,0101264,0023775,0176351, 0141504,0140420,0050660,0036543, }; #endif #if IBMPC static short P[24] = { 0x8ad3,0x0bd4,0x6b9b,0x3f71, 0x5c16,0x333e,0x4341,0xbfe3, 0x2dd9,0x178a,0xc74b,0x4015, 0x907b,0xde27,0x4331,0xc030, 0x9259,0xda77,0x9007,0x4033, 0xafd5,0x06ce,0x656c,0xc020, }; static short Q[20] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0x0eab,0x0b5e,0x7b59,0xc02d, 0x9054,0x25fe,0x9fc0,0x4051, 0x76d7,0x6d35,0x65bb,0xc062, 0xbf9d,0x84ff,0x7056,0x4061, 0x07ac,0x0a36,0x9822,0xc048, }; #endif #if MIEEE static short P[24] = { 0x3f71,0x6b9b,0x0bd4,0x8ad3, 0xbfe3,0x4341,0x333e,0x5c16, 0x4015,0xc74b,0x178a,0x2dd9, 0xc030,0x4331,0xde27,0x907b, 0x4033,0x9007,0xda77,0x9259, 0xc020,0x656c,0x06ce,0xafd5, }; static short Q[20] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0xc02d,0x7b59,0x0b5e,0x0eab, 0x4051,0x9fc0,0x25fe,0x9054, 0xc062,0x65bb,0x6d35,0x76d7, 0x4061,0x7056,0x84ff,0xbf9d, 0xc048,0x9822,0x0a36,0x07ac, }; #endif /* arcsin(1-x) = pi/2 - sqrt(2x)(1+R(x)) 0 <= x <= 0.5 Peak relative error = 4.2e-18 */ #if UNK static double R[5] = { 2.967721961301243206100E-3, -5.634242780008963776856E-1, 6.968710824104713396794E0, -2.556901049652824852289E1, 2.853665548261061424989E1, }; static double S[4] = { /* 1.000000000000000000000E0, */ -2.194779531642920639778E1, 1.470656354026814941758E2, -3.838770957603691357202E2, 3.424398657913078477438E2, }; #endif #if DEC static short R[20] = { 0036102,0077034,0142164,0174103, 0140020,0036222,0147711,0044173, 0040736,0177655,0153631,0171523, 0141314,0106525,0060015,0055474, 0041344,0045422,0003630,0040344, }; static short S[16] = { /* 0040200,0000000,0000000,0000000, */ 0141257,0112425,0132772,0166136, 0042023,0010315,0075523,0175020, 0142277,0170104,0126203,0017563, 0042253,0034115,0102662,0022757, }; #endif #if IBMPC static short R[20] = { 0x9f08,0x988e,0x4fc3,0x3f68, 0x290f,0x59f9,0x0792,0xbfe2, 0x3e6a,0xbaf3,0xdff5,0x401b, 0xab68,0xac01,0x91aa,0xc039, 0x081d,0x40f3,0x8962,0x403c, }; static short S[16] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0x5d8c,0xb6bf,0xf2a2,0xc035, 0x7f42,0xaf6a,0x6219,0x4062, 0x63ee,0x9590,0xfe08,0xc077, 0x44be,0xb0b6,0x6709,0x4075, }; #endif #if MIEEE static short R[20] = { 0x3f68,0x4fc3,0x988e,0x9f08, 0xbfe2,0x0792,0x59f9,0x290f, 0x401b,0xdff5,0xbaf3,0x3e6a, 0xc039,0x91aa,0xac01,0xab68, 0x403c,0x8962,0x40f3,0x081d, }; static short S[16] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0xc035,0xf2a2,0xb6bf,0x5d8c, 0x4062,0x6219,0xaf6a,0x7f42, 0xc077,0xfe08,0x9590,0x63ee, 0x4075,0x6709,0xb0b6,0x44be, }; #endif /* pi/2 = PIO2 + MOREBITS. */ #ifdef DEC #define MOREBITS 5.721188726109831840122E-18 #else #define MOREBITS 6.123233995736765886130E-17 #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double sqrt ( double ); double md_asin ( double ); #else double sqrt(), polevl(), p1evl(); double md_asin(); #endif extern double PIO2, PIO4, NAN; double md_asin(x) double x; { double a, p, z, zz; short sign; if( x > 0 ) { sign = 1; a = x; } else { sign = -1; a = -x; } if( a > 1.0 ) { mtherr( "md_asin", DOMAIN ); return( NAN ); } if( a > 0.625 ) { /* arcsin(1-x) = pi/2 - sqrt(2x)(1+R(x)) */ zz = 1.0 - a; p = zz * polevl( zz, R, 4)/p1evl( zz, S, 4); zz = sqrt(zz+zz); z = PIO4 - zz; zz = zz * p - MOREBITS; z = z - zz; z = z + PIO4; } else { if( a < 1.0e-8 ) { return(x); } zz = a * a; z = zz * polevl( zz, P, 5)/p1evl( zz, Q, 5); z = a * z + a; } if( sign < 0 ) z = -z; return(z); } double md_acos(x) double x; { double z; if( (x < -1.0) || (x > 1.0) ) { mtherr( "md_acos", DOMAIN ); return( NAN ); } if( x > 0.5 ) { return( 2.0 * md_asin( sqrt(0.5 - 0.5*x) ) ); } z = PIO4 - md_asin(x); z = z + MOREBITS; z = z + PIO4; return( z ); } Math-Cephes-0.5306/libmd/bdtr.c0000644000175000017500000001146114757021403015765 0ustar shlomifshlomif/* bdtr.c * * Binomial distribution * * * * SYNOPSIS: * * int k, n; * double p, y, bdtr(); * * y = bdtr( k, n, p ); * * DESCRIPTION: * * Returns the sum of the terms 0 through k of the Binomial * probability density: * * k * -- ( n ) j n-j * > ( ) p (1-p) * -- ( j ) * j=0 * * The terms are not summed directly; instead the incomplete * beta integral is employed, according to the formula * * y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ). * * The arguments must be positive, with p ranging from 0 to 1. * * ACCURACY: * * Tested at random points (a,b,p), with p between 0 and 1. * * a,b Relative error: * arithmetic domain # trials peak rms * For p between 0.001 and 1: * IEEE 0,100 100000 4.3e-15 2.6e-16 * See also incbet.c. * * ERROR MESSAGES: * * message condition value returned * bdtr domain k < 0 0.0 * n < k * x < 0, x > 1 */ /* bdtrc() * * Complemented binomial distribution * * * * SYNOPSIS: * * int k, n; * double p, y, bdtrc(); * * y = bdtrc( k, n, p ); * * DESCRIPTION: * * Returns the sum of the terms k+1 through n of the Binomial * probability density: * * n * -- ( n ) j n-j * > ( ) p (1-p) * -- ( j ) * j=k+1 * * The terms are not summed directly; instead the incomplete * beta integral is employed, according to the formula * * y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ). * * The arguments must be positive, with p ranging from 0 to 1. * * ACCURACY: * * Tested at random points (a,b,p). * * a,b Relative error: * arithmetic domain # trials peak rms * For p between 0.001 and 1: * IEEE 0,100 100000 6.7e-15 8.2e-16 * For p between 0 and .001: * IEEE 0,100 100000 1.5e-13 2.7e-15 * * ERROR MESSAGES: * * message condition value returned * bdtrc domain x<0, x>1, n 1 */ /* bdtr() */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double incbet ( double, double, double ); extern double incbi ( double, double, double ); extern double md_pow ( double, double ); extern double md_log1p ( double ); extern double expm1 ( double ); #else double incbet(), incbi(), md_pow(), md_log1p(), expm1(); #endif double bdtrc( k, n, p ) int k, n; double p; { double dk, dn; if( (p < 0.0) || (p > 1.0) ) goto domerr; if( k < 0 ) return( 1.0 ); if( n < k ) { domerr: mtherr( "bdtrc", DOMAIN ); return( 0.0 ); } if( k == n ) return( 0.0 ); dn = n - k; if( k == 0 ) { if( p < .01 ) dk = -expm1( dn * md_log1p(-p) ); else dk = 1.0 - md_pow( 1.0-p, dn ); } else { dk = k + 1; dk = incbet( dk, dn, p ); } return( dk ); } double bdtr( k, n, p ) int k, n; double p; { double dk, dn; if( (p < 0.0) || (p > 1.0) ) goto domerr; if( (k < 0) || (n < k) ) { domerr: mtherr( "bdtr", DOMAIN ); return( 0.0 ); } if( k == n ) return( 1.0 ); dn = n - k; if( k == 0 ) { dk = md_pow( 1.0-p, dn ); } else { dk = k + 1; dk = incbet( dn, dk, 1.0 - p ); } return( dk ); } double bdtri( k, n, y ) int k, n; double y; { double dk, dn, p; if( (y < 0.0) || (y > 1.0) ) goto domerr; if( (k < 0) || (n <= k) ) { domerr: mtherr( "bdtri", DOMAIN ); return( 0.0 ); } dn = n - k; if( k == 0 ) { if( y > 0.8 ) p = -expm1( md_log1p(y-1.0) / dn ); else p = 1.0 - md_pow( y, 1.0/dn ); } else { dk = k + 1; p = incbet( dn, dk, 0.5 ); if( p > 0.5 ) p = incbi( dk, dn, 1.0-y ); else p = 1.0 - incbi( dn, dk, y ); } return( p ); } Math-Cephes-0.5306/libmd/ellie.c0000644000175000017500000000542714757021403016131 0ustar shlomifshlomif/* ellie.c * * Incomplete elliptic integral of the second kind * * * * SYNOPSIS: * * double phi, m, y, ellie(); * * y = ellie( phi, m ); * * * * DESCRIPTION: * * Approximates the integral * * * phi * - * | | * | 2 * E(phi_\m) = | sqrt( 1 - m md_sin t ) dt * | * | | * - * 0 * * of amplitude phi and modulus m, using the arithmetic - * geometric mean algorithm. * * * * ACCURACY: * * Tested at random arguments with phi in [-10, 10] and m in * [0, 1]. * Relative error: * arithmetic domain # trials peak rms * DEC 0,2 2000 1.9e-16 3.4e-17 * IEEE -10,10 150000 3.3e-15 1.4e-16 * * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1993, 2000 by Stephen L. Moshier */ /* Incomplete elliptic integral of second kind */ #include "mconf.h" extern double PI, PIO2, MACHEP; #ifdef ANSIPROT extern double sqrt ( double ); extern double md_fabs ( double ); extern double md_log ( double ); extern double md_sin ( double x ); extern double md_tan ( double x ); extern double md_atan ( double ); extern double md_floor ( double ); extern double ellpe ( double ); extern double ellpk ( double ); double ellie ( double, double ); #else double sqrt(), md_fabs(), md_log(), md_sin(), md_tan(), md_atan(), md_floor(); double ellpe(), ellpk(), ellie(); #endif double ellie( phi, m ) double phi, m; { double a, b, c, e, temp; double lphi, t, E; int d, mod, npio2, sign; if( m == 0.0 ) return( phi ); lphi = phi; npio2 = md_floor( lphi/PIO2 ); if( npio2 & 1 ) npio2 += 1; lphi = lphi - npio2 * PIO2; if( lphi < 0.0 ) { lphi = -lphi; sign = -1; } else { sign = 1; } a = 1.0 - m; E = ellpe( a ); if( a == 0.0 ) { temp = md_sin( lphi ); goto done; } t = md_tan( lphi ); b = sqrt(a); /* Thanks to Brian Fitzgerald for pointing out an instability near odd multiples of pi/2. */ if( md_fabs(t) > 10.0 ) { /* Transform the amplitude */ e = 1.0/(b*t); /* ... but avoid multiple recursions. */ if( md_fabs(e) < 10.0 ) { e = md_atan(e); temp = E + m * md_sin( lphi ) * md_sin( e ) - ellie( e, m ); goto done; } } c = sqrt(m); a = 1.0; d = 1; e = 0.0; mod = 0; while( md_fabs(c/a) > MACHEP ) { temp = b/a; lphi = lphi + md_atan(t*temp) + mod * PI; mod = (lphi + PIO2)/PI; t = t * ( 1.0 + temp )/( 1.0 - temp * t * t ); c = ( a - b )/2.0; temp = sqrt( a * b ); a = ( a + b )/2.0; b = temp; d += d; e += c * md_sin(lphi); } temp = E / ellpk( 1.0 - m ); temp *= (md_atan(t) + mod * PI)/(d * a); temp += e; done: if( sign < 0 ) temp = -temp; temp += npio2 * E; return( temp ); } Math-Cephes-0.5306/libmd/exp2.c0000644000175000017500000000651314757021403015712 0ustar shlomifshlomif/* md_exp2.c * * Base 2 exponential function * * * * SYNOPSIS: * * double x, y, md_exp2(); * * y = md_exp2( x ); * * * * DESCRIPTION: * * Returns 2 raised to the x power. * * Range reduction is accomplished by separating the argument * into an integer k and fraction f such that * x k f * 2 = 2 2. * * A Pade' form * * 1 + 2x P(x**2) / (Q(x**2) - x P(x**2) ) * * approximates 2**x in the basic range [-0.5, 0.5]. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -1022,+1024 30000 1.8e-16 5.4e-17 * * * See md_exp.c for comments on error amplification. * * * ERROR MESSAGES: * * message condition value returned * md_exp underflow x < -MAXL2 0.0 * md_exp overflow x > MAXL2 MAXNUM * * For DEC arithmetic, MAXL2 = 127. * For IEEE arithmetic, MAXL2 = 1024. */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double P[] = { 2.30933477057345225087E-2, 2.02020656693165307700E1, 1.51390680115615096133E3, }; static double Q[] = { /* 1.00000000000000000000E0,*/ 2.33184211722314911771E2, 4.36821166879210612817E3, }; #define MAXL2 1024.0 #define MINL2 -1024.0 #endif #ifdef DEC static unsigned short P[] = { 0036675,0027102,0122327,0053227, 0041241,0116724,0115412,0157355, 0042675,0036404,0101733,0132226, }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0042151,0027450,0077732,0160744, 0043210,0100661,0077550,0056560, }; #define MAXL2 127.0 #define MINL2 -127.0 #endif #ifdef IBMPC static unsigned short P[] = { 0xead3,0x549a,0xa5c8,0x3f97, 0x5bde,0x9361,0x33ba,0x4034, 0x7693,0x907b,0xa7a0,0x4097, }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x5c3c,0x0ffb,0x25e5,0x406d, 0x0bae,0x2fed,0x1036,0x40b1, }; #define MAXL2 1024.0 #define MINL2 -1022.0 #endif #ifdef MIEEE static unsigned short P[] = { 0x3f97,0xa5c8,0x549a,0xead3, 0x4034,0x33ba,0x9361,0x5bde, 0x4097,0xa7a0,0x907b,0x7693, }; static unsigned short Q[] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x406d,0x25e5,0x0ffb,0x5c3c, 0x40b1,0x1036,0x2fed,0x0bae, }; #define MAXL2 1024.0 #define MINL2 -1022.0 #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_floor ( double ); extern double md_ldexp ( double, int ); extern int isnan ( double ); extern int isfinite ( double ); #else double polevl(), p1evl(), md_floor(), md_ldexp(); int isnan(), isfinite(); #endif #ifdef INFINITIES extern double INFINITY; #endif extern double MAXNUM; double md_exp2(x) double x; { double px, xx; short n; #ifdef NANS if( isnan(x) ) return(x); #endif if( x > MAXL2) { #ifdef INFINITIES return( INFINITY ); #else mtherr( "md_exp2", OVERFLOW ); return( MAXNUM ); #endif } if( x < MINL2 ) { #ifndef INFINITIES mtherr( "md_exp2", UNDERFLOW ); #endif return(0.0); } xx = x; /* save x */ /* separate into integer and fractional parts */ px = md_floor(x+0.5); n = px; x = x - px; /* rational approximation * md_exp2(x) = 1 + 2xP(xx)/(Q(xx) - P(xx)) * where xx = x**2 */ xx = x * x; px = x * polevl( xx, P, 2 ); x = px / ( p1evl( xx, Q, 2 ) - px ); x = 1.0 + md_ldexp( x, 1 ); /* scale by power of 2 */ x = md_ldexp( x, n ); return(x); } Math-Cephes-0.5306/libmd/nbdtr.c0000644000175000017500000000652014757021403016143 0ustar shlomifshlomif/* nbdtr.c * * Negative binomial distribution * * * * SYNOPSIS: * * int k, n; * double p, y, nbdtr(); * * y = nbdtr( k, n, p ); * * DESCRIPTION: * * Returns the sum of the terms 0 through k of the negative * binomial distribution: * * k * -- ( n+j-1 ) n j * > ( ) p (1-p) * -- ( j ) * j=0 * * In a sequence of Bernoulli trials, this is the probability * that k or fewer failures precede the nth success. * * The terms are not computed individually; instead the incomplete * beta integral is employed, according to the formula * * y = nbdtr( k, n, p ) = incbet( n, k+1, p ). * * The arguments must be positive, with p ranging from 0 to 1. * * ACCURACY: * * Tested at random points (a,b,p), with p between 0 and 1. * * a,b Relative error: * arithmetic domain # trials peak rms * IEEE 0,100 100000 1.7e-13 8.8e-15 * See also incbet.c. * */ /* nbdtr.c * * Complemented negative binomial distribution * * * * SYNOPSIS: * * int k, n; * double p, y, nbdtrc(); * * y = nbdtrc( k, n, p ); * * DESCRIPTION: * * Returns the sum of the terms k+1 to infinity of the negative * binomial distribution: * * inf * -- ( n+j-1 ) n j * > ( ) p (1-p) * -- ( j ) * j=k+1 * * The terms are not computed individually; instead the incomplete * beta integral is employed, according to the formula * * y = nbdtrc( k, n, p ) = incbet( k+1, n, 1-p ). * * The arguments must be positive, with p ranging from 0 to 1. * * ACCURACY: * * Tested at random points (a,b,p), with p between 0 and 1. * * a,b Relative error: * arithmetic domain # trials peak rms * IEEE 0,100 100000 1.7e-13 8.8e-15 * See also incbet.c. */ /* nbdtr.c * * Functional inverse of negative binomial distribution * * * * SYNOPSIS: * * int k, n; * double p, y, nbdtri(); * * p = nbdtri( k, n, y ); * * DESCRIPTION: * * Finds the argument p such that nbdtr(k,n,p) is equal to y. * * ACCURACY: * * Tested at random points (a,b,y), with y between 0 and 1. * * a,b Relative error: * arithmetic domain # trials peak rms * IEEE 0,100 100000 1.5e-14 8.5e-16 * See also incbi.c. */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double incbet ( double, double, double ); extern double incbi ( double, double, double ); #else double incbet(), incbi(); #endif double nbdtrc( k, n, p ) int k, n; double p; { double dk, dn; if( (p < 0.0) || (p > 1.0) ) goto domerr; if( k < 0 ) { domerr: mtherr( "nbdtr", DOMAIN ); return( 0.0 ); } dk = k+1; dn = n; return( incbet( dk, dn, 1.0 - p ) ); } double nbdtr( k, n, p ) int k, n; double p; { double dk, dn; if( (p < 0.0) || (p > 1.0) ) goto domerr; if( k < 0 ) { domerr: mtherr( "nbdtr", DOMAIN ); return( 0.0 ); } dk = k+1; dn = n; return( incbet( dn, dk, p ) ); } double nbdtri( k, n, p ) int k, n; double p; { double dk, dn, w; if( (p < 0.0) || (p > 1.0) ) goto domerr; if( k < 0 ) { domerr: mtherr( "nbdtri", DOMAIN ); return( 0.0 ); } dk = k+1; dn = n; w = incbi( dn, dk, p ); return( w ); } Math-Cephes-0.5306/libmd/sqrtelf.3870000644000175000017500000000026014757021403016604 0ustar shlomifshlomif .file "sqrt.i" gcc2_compiled.: .version "01.01" .text .align 16 .globl sqrt sqrt: pushl %ebp movl %esp,%ebp fldl 8(%ebp) fsqrt leave ret .Lfe1: .size sqrt,.Lfe1-sqrt Math-Cephes-0.5306/libmd/igami.c0000644000175000017500000000637414757021403016127 0ustar shlomifshlomif/* igami() * * Inverse of complemented imcomplete md_gamma integral * * * * SYNOPSIS: * * double a, x, p, igami(); * * x = igami( a, p ); * * DESCRIPTION: * * Given p, the function finds x such that * * It is valid in the right-hand-tail of the distribution, p < 0.5. * igamc( a, x ) = p. * * Starting with the approximate value * * 3 * x = a t * * where * * t = 1 - d - ndtri(p) sqrt(d) * * and * * d = 1/9a, * * the routine performs up to 10 Newton iterations to find the * root of igamc(a,x) - p = 0. * * ACCURACY: * * Tested at random a, p in the intervals indicated. * * a p Relative error: * arithmetic domain domain # trials peak rms * IEEE 0.5,100 0,0.5 100000 1.0e-14 1.7e-15 * IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15 * IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14 */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" extern double MACHEP, MAXNUM, MAXLOG, MINLOG; #ifdef ANSIPROT extern double igamc ( double, double ); extern double ndtri ( double ); extern double md_exp ( double ); extern double md_fabs ( double ); extern double md_log ( double ); extern double sqrt ( double ); extern double lgam ( double ); #else double igamc(), ndtri(), md_exp(), md_fabs(), md_log(), sqrt(), lgam(); #endif double igami( a, md_y0 ) double a, md_y0; { double x0, x1, x, yl, yh, y, d, lgm, dithresh; int i, dir; if( md_y0 > 0.5) mtherr( "igami", PLOSS); /* bound the solution */ x0 = MAXNUM; yl = 0; x1 = 0; yh = 1.0; dithresh = 5.0 * MACHEP; /* approximation to inverse function */ d = 1.0/(9.0*a); y = ( 1.0 - d - ndtri(md_y0) * sqrt(d) ); x = a * y * y * y; lgm = lgam(a); for( i=0; i<10; i++ ) { if( x > x0 || x < x1 ) goto ihalve; y = igamc(a,x); if( y < yl || y > yh ) goto ihalve; if( y < md_y0 ) { x0 = x; yl = y; } else { x1 = x; yh = y; } /* compute the derivative of the function at this point */ d = (a - 1.0) * md_log(x) - x - lgm; if( d < -MAXLOG ) goto ihalve; d = -md_exp(d); /* compute the step to the next approximation of x */ d = (y - md_y0)/d; if( md_fabs(d/x) < MACHEP ) goto done; x = x - d; } /* Resort to interval halving if Newton iteration did not converge. */ ihalve: d = 0.0625; if( x0 == MAXNUM ) { if( x <= 0.0 ) x = 1.0; while( x0 == MAXNUM ) { x = (1.0 + d) * x; y = igamc( a, x ); if( y < md_y0 ) { x0 = x; yl = y; break; } d = d + d; } } d = 0.5; dir = 0; for( i=0; i<400; i++ ) { x = x1 + d * (x0 - x1); y = igamc( a, x ); lgm = (x0 - x1)/(x1 + x0); if( md_fabs(lgm) < dithresh ) break; lgm = (y - md_y0)/md_y0; if( md_fabs(lgm) < dithresh ) break; if( x <= 0.0 ) break; if( y >= md_y0 ) { x1 = x; yh = y; if( dir < 0 ) { dir = 0; d = 0.5; } else if( dir > 1 ) d = 0.5 * d + 0.5; else d = (md_y0 - yl)/(yh - yl); dir += 1; } else { x0 = x; yl = y; if( dir > 0 ) { dir = 0; d = 0.5; } else if( dir < -1 ) d = 0.5 * d; else d = (md_y0 - yl)/(yh - yl); dir -= 1; } } if( x == 0.0 ) mtherr( "igami", UNDERFLOW ); done: return( x ); } Math-Cephes-0.5306/libmd/sinh.c0000644000175000017500000000545714757021403016003 0ustar shlomifshlomif/* md_sinh.c * * Hyperbolic sine * * * * SYNOPSIS: * * double x, y, md_sinh(); * * y = md_sinh( x ); * * * * DESCRIPTION: * * Returns hyperbolic sine of argument in the range MINLOG to * MAXLOG. * * The range is partitioned into two segments. If |x| <= 1, a * rational function of the form x + x**3 P(x)/Q(x) is employed. * Otherwise the calculation is md_sinh(x) = ( md_exp(x) - md_exp(-x) )/2. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC +- 88 50000 4.0e-17 7.7e-18 * IEEE +-MAXLOG 30000 2.6e-16 5.7e-17 * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double P[] = { -7.89474443963537015605E-1, -1.63725857525983828727E2, -1.15614435765005216044E4, -3.51754964808151394800E5 }; static double Q[] = { /* 1.00000000000000000000E0,*/ -2.77711081420602794433E2, 3.61578279834431989373E4, -2.11052978884890840399E6 }; #endif #ifdef DEC static unsigned short P[] = { 0140112,0015377,0042731,0163255, 0142043,0134721,0146177,0123761, 0143464,0122706,0034353,0006017, 0144653,0140536,0157665,0054045 }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0142212,0155404,0133513,0022040, 0044015,0036723,0173271,0011053, 0145400,0150407,0023710,0001034 }; #endif #ifdef IBMPC static unsigned short P[] = { 0x3cd6,0xe8bb,0x435f,0xbfe9, 0xf4fe,0x398f,0x773a,0xc064, 0x6182,0xc71d,0x94b8,0xc0c6, 0xab05,0xdbf6,0x782b,0xc115 }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x6484,0x96e9,0x5b60,0xc071, 0x2245,0x7ed7,0xa7ba,0x40e1, 0x0044,0xe4f9,0x1a20,0xc140 }; #endif #ifdef MIEEE static unsigned short P[] = { 0xbfe9,0x435f,0xe8bb,0x3cd6, 0xc064,0x773a,0x398f,0xf4fe, 0xc0c6,0x94b8,0xc71d,0x6182, 0xc115,0x782b,0xdbf6,0xab05 }; static unsigned short Q[] = { 0xc071,0x5b60,0x96e9,0x6484, 0x40e1,0xa7ba,0x7ed7,0x2245, 0xc140,0x1a20,0xe4f9,0x0044 }; #endif #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_exp ( double ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); #else double md_fabs(), md_exp(), polevl(), p1evl(); #endif extern double INFINITY, MINLOG, MAXLOG, LOGE2; double md_sinh(x) double x; { double a; #ifdef MINUSZERO if( x == 0.0 ) return(x); #endif a = md_fabs(x); if( (x > (MAXLOG + LOGE2)) || (x > -(MINLOG-LOGE2) ) ) { mtherr( "md_sinh", DOMAIN ); if( x > 0 ) return( INFINITY ); else return( -INFINITY ); } if( a > 1.0 ) { if( a >= (MAXLOG - LOGE2) ) { a = md_exp(0.5*a); a = (0.5 * a) * a; if( x < 0 ) a = -a; return(a); } a = md_exp(a); a = 0.5*a - (0.5/a); if( x < 0 ) a = -a; return(a); } a *= a; return( x + x * a * (polevl(a,P,3)/p1evl(a,Q,3)) ); } Math-Cephes-0.5306/libmd/k1.c0000644000175000017500000001622514757021403015350 0ustar shlomifshlomif/* k1.c * * Modified Bessel function, third kind, order one * * * * SYNOPSIS: * * double x, y, k1(); * * y = k1( x ); * * * * DESCRIPTION: * * Computes the modified Bessel function of the third kind * of order one of the argument. * * The range is partitioned into the two intervals [0,2] and * (2, infinity). Chebyshev polynomial expansions are employed * in each interval. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 0, 30 3300 8.9e-17 2.2e-17 * IEEE 0, 30 30000 1.2e-15 1.6e-16 * * ERROR MESSAGES: * * message condition value returned * k1 domain x <= 0 MAXNUM * */ /* k1e.c * * Modified Bessel function, third kind, order one, * exponentially scaled * * * * SYNOPSIS: * * double x, y, k1e(); * * y = k1e( x ); * * * * DESCRIPTION: * * Returns exponentially scaled modified Bessel function * of the third kind of order one of the argument: * * k1e(x) = md_exp(x) * k1(x). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0, 30 30000 7.8e-16 1.2e-16 * See k1(). * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" /* Chebyshev coefficients for x(K1(x) - md_log(x/2) I1(x)) * in the interval [0,2]. * * lim(x->0){ x(K1(x) - md_log(x/2) I1(x)) } = 1. */ #ifdef UNK static double A[] = { -7.02386347938628759343E-18, -2.42744985051936593393E-15, -6.66690169419932900609E-13, -1.41148839263352776110E-10, -2.21338763073472585583E-8, -2.43340614156596823496E-6, -1.73028895751305206302E-4, -6.97572385963986435018E-3, -1.22611180822657148235E-1, -3.53155960776544875667E-1, 1.52530022733894777053E0 }; #endif #ifdef DEC static unsigned short A[] = { 0122001,0110501,0164746,0151255, 0124056,0165213,0150034,0147377, 0126073,0124026,0167207,0001044, 0130033,0030735,0141061,0033116, 0131676,0020350,0121341,0107175, 0133443,0046631,0062031,0070716, 0135065,0067427,0026435,0164022, 0136344,0112234,0165752,0006222, 0137373,0015622,0017016,0155636, 0137664,0150333,0125730,0067240, 0040303,0036411,0130200,0043120 }; #endif #ifdef IBMPC static unsigned short A[] = { 0xda56,0x3d3c,0x3228,0xbc60, 0x99e0,0x7a03,0xdd51,0xbce5, 0xe045,0xddd0,0x7502,0xbd67, 0x26ca,0xb846,0x663b,0xbde3, 0x31d0,0x145c,0xc41d,0xbe57, 0x2e3a,0x2c83,0x69b3,0xbec4, 0xbd02,0xe5a3,0xade2,0xbf26, 0x4192,0x9d7d,0x9293,0xbf7c, 0xdb74,0x43c1,0x6372,0xbfbf, 0x0dd4,0x757b,0x9a1b,0xbfd6, 0x08ca,0x3610,0x67a1,0x3ff8 }; #endif #ifdef MIEEE static unsigned short A[] = { 0xbc60,0x3228,0x3d3c,0xda56, 0xbce5,0xdd51,0x7a03,0x99e0, 0xbd67,0x7502,0xddd0,0xe045, 0xbde3,0x663b,0xb846,0x26ca, 0xbe57,0xc41d,0x145c,0x31d0, 0xbec4,0x69b3,0x2c83,0x2e3a, 0xbf26,0xade2,0xe5a3,0xbd02, 0xbf7c,0x9293,0x9d7d,0x4192, 0xbfbf,0x6372,0x43c1,0xdb74, 0xbfd6,0x9a1b,0x757b,0x0dd4, 0x3ff8,0x67a1,0x3610,0x08ca }; #endif /* Chebyshev coefficients for md_exp(x) sqrt(x) K1(x) * in the interval [2,infinity]. * * lim(x->inf){ md_exp(x) sqrt(x) K1(x) } = sqrt(pi/2). */ #ifdef UNK static double B[] = { -5.75674448366501715755E-18, 1.79405087314755922667E-17, -5.68946255844285935196E-17, 1.83809354436663880070E-16, -6.05704724837331885336E-16, 2.03870316562433424052E-15, -7.01983709041831346144E-15, 2.47715442448130437068E-14, -8.97670518232499435011E-14, 3.34841966607842919884E-13, -1.28917396095102890680E-12, 5.13963967348173025100E-12, -2.12996783842756842877E-11, 9.21831518760500529508E-11, -4.19035475934189648750E-10, 2.01504975519703286596E-9, -1.03457624656780970260E-8, 5.74108412545004946722E-8, -3.50196060308781257119E-7, 2.40648494783721712015E-6, -1.93619797416608296024E-5, 1.95215518471351631108E-4, -2.85781685962277938680E-3, 1.03923736576817238437E-1, 2.72062619048444266945E0 }; #endif #ifdef DEC static unsigned short B[] = { 0121724,0061352,0013041,0150076, 0022245,0074324,0016172,0173232, 0122603,0030250,0135670,0165221, 0023123,0165362,0023561,0060124, 0123456,0112436,0141654,0073623, 0024022,0163557,0077564,0006753, 0124374,0165221,0131014,0026524, 0024737,0017512,0144250,0175451, 0125312,0021456,0123136,0076633, 0025674,0077720,0020125,0102607, 0126265,0067543,0007744,0043701, 0026664,0152702,0033002,0074202, 0127273,0055234,0120016,0071733, 0027712,0133200,0042441,0075515, 0130346,0057000,0015456,0074470, 0031012,0074441,0051636,0111155, 0131461,0136444,0177417,0002101, 0032166,0111743,0032176,0021410, 0132674,0001224,0076555,0027060, 0033441,0077430,0135226,0106663, 0134242,0065610,0167155,0113447, 0035114,0131304,0043664,0102163, 0136073,0045065,0171465,0122123, 0037324,0152767,0147401,0017732, 0040456,0017275,0050061,0062120, }; #endif #ifdef IBMPC static unsigned short B[] = { 0x3a08,0x42c4,0x8c5d,0xbc5a, 0x5ed3,0x838f,0xaf1a,0x3c74, 0x1d52,0x1777,0x6615,0xbc90, 0x2c0b,0x44ee,0x7d5e,0x3caa, 0x8ef2,0xd875,0xd2a3,0xbcc5, 0x81bd,0xefee,0x5ced,0x3ce2, 0x85ab,0x3641,0x9d52,0xbcff, 0x1f65,0x5915,0xe3e9,0x3d1b, 0xcfb3,0xd4cb,0x4465,0xbd39, 0xb0b1,0x040a,0x8ffa,0x3d57, 0x88f8,0x61fc,0xadec,0xbd76, 0x4f10,0x46c0,0x9ab8,0x3d96, 0xce7b,0x9401,0x6b53,0xbdb7, 0x2f6a,0x08a4,0x56d0,0x3dd9, 0xcf27,0x0365,0xcbc0,0xbdfc, 0xd24e,0x2a73,0x4f24,0x3e21, 0xe088,0x9fe1,0x37a4,0xbe46, 0xc461,0x668f,0xd27c,0x3e6e, 0xa5c6,0x8fad,0x8052,0xbe97, 0xd1b6,0x1752,0x2fe3,0x3ec4, 0xb2e5,0x1dcd,0x4d71,0xbef4, 0x908e,0x88f6,0x9658,0x3f29, 0xb48a,0xbe66,0x6946,0xbf67, 0x23fb,0xf9e0,0x9abe,0x3fba, 0x2c8a,0xaa06,0xc3d7,0x4005 }; #endif #ifdef MIEEE static unsigned short B[] = { 0xbc5a,0x8c5d,0x42c4,0x3a08, 0x3c74,0xaf1a,0x838f,0x5ed3, 0xbc90,0x6615,0x1777,0x1d52, 0x3caa,0x7d5e,0x44ee,0x2c0b, 0xbcc5,0xd2a3,0xd875,0x8ef2, 0x3ce2,0x5ced,0xefee,0x81bd, 0xbcff,0x9d52,0x3641,0x85ab, 0x3d1b,0xe3e9,0x5915,0x1f65, 0xbd39,0x4465,0xd4cb,0xcfb3, 0x3d57,0x8ffa,0x040a,0xb0b1, 0xbd76,0xadec,0x61fc,0x88f8, 0x3d96,0x9ab8,0x46c0,0x4f10, 0xbdb7,0x6b53,0x9401,0xce7b, 0x3dd9,0x56d0,0x08a4,0x2f6a, 0xbdfc,0xcbc0,0x0365,0xcf27, 0x3e21,0x4f24,0x2a73,0xd24e, 0xbe46,0x37a4,0x9fe1,0xe088, 0x3e6e,0xd27c,0x668f,0xc461, 0xbe97,0x8052,0x8fad,0xa5c6, 0x3ec4,0x2fe3,0x1752,0xd1b6, 0xbef4,0x4d71,0x1dcd,0xb2e5, 0x3f29,0x9658,0x88f6,0x908e, 0xbf67,0x6946,0xbe66,0xb48a, 0x3fba,0x9abe,0xf9e0,0x23fb, 0x4005,0xc3d7,0xaa06,0x2c8a }; #endif #ifdef ANSIPROT extern double chbevl ( double, void *, int ); extern double md_exp ( double ); extern double i1 ( double ); extern double md_log ( double ); extern double sqrt ( double ); #else double chbevl(), md_exp(), i1(), md_log(), sqrt(); #endif extern double PI; extern double MINLOG, MAXNUM; double k1(x) double x; { double y, z; z = 0.5 * x; if( z <= 0.0 ) { mtherr( "k1", DOMAIN ); return( MAXNUM ); } if( x <= 2.0 ) { y = x * x - 2.0; y = md_log(z) * i1(x) + chbevl( y, A, 11 ) / x; return( y ); } return( md_exp(-x) * chbevl( 8.0/x - 2.0, B, 25 ) / sqrt(x) ); } double k1e( x ) double x; { double y; if( x <= 0.0 ) { mtherr( "k1e", DOMAIN ); return( MAXNUM ); } if( x <= 2.0 ) { y = x * x - 2.0; y = md_log( 0.5 * x ) * i1(x) + chbevl( y, A, 11 ) / x; return( y * md_exp(x) ); } return( chbevl( 8.0/x - 2.0, B, 25 ) / sqrt(x) ); } Math-Cephes-0.5306/libmd/expx2.c0000644000175000017500000000314414757021403016077 0ustar shlomifshlomif/* expx2.c * * Exponential of squared argument * * * * SYNOPSIS: * * double x, y, expx2(); * int sign; * * y = expx2( x, sign ); * * * * DESCRIPTION: * * Computes y = md_exp(x*x) while suppressing error amplification * that would ordinarily arise from the inexactness of the * exponential argument x*x. * * If sign < 0, the result is inverted; i.e., y = md_exp(-x*x) . * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -26.6, 26.6 10^7 3.9e-16 8.9e-17 * */ /* Cephes Math Library Release 2.9: June, 2000 Copyright 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double md_fabs (double); extern double md_floor (double); extern double md_exp (double); #else double md_fabs(); double md_floor(); double md_exp(); #endif #ifdef DEC #define M 32.0 #define MINV .03125 #else #define M 128.0 #define MINV .0078125 #endif extern double MAXLOG; extern double INFINITY; double expx2 (x, sign) double x; int sign; { double u, u1, m, f; x = md_fabs (x); if (sign < 0) x = -x; /* Represent x as an exact multiple of M plus a residual. M is a power of 2 chosen so that md_exp(m * m) does not overflow or underflow and so that |x - m| is small. */ m = MINV * md_floor(M * x + 0.5); f = x - m; /* x^2 = m^2 + 2mf + f^2 */ u = m * m; u1 = 2 * m * f + f * f; if (sign < 0) { u = -u; u1 = -u1; } if ((u+u1) > MAXLOG) return (INFINITY); /* u is exact, u1 is small. */ u = md_exp(u) * md_exp(u1); return(u); } Math-Cephes-0.5306/libmd/beta.c0000644000175000017500000000566614757021403015757 0ustar shlomifshlomif/* beta.c * * Beta function * * * * SYNOPSIS: * * double a, b, y, beta(); * * y = beta( a, b ); * * * * DESCRIPTION: * * - - * | (a) | (b) * beta( a, b ) = -----------. * - * | (a+b) * * For large arguments the logarithm of the function is * evaluated using lgam(), then exponentiated. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 0,30 1700 7.7e-15 1.5e-15 * IEEE 0,30 30000 8.1e-14 1.1e-14 * * ERROR MESSAGES: * * message condition value returned * beta overflow md_log(beta) > MAXLOG 0.0 * a or b <0 integer 0.0 * */ /* beta.c */ /* Cephes Math Library Release 2.0: April, 1987 Copyright 1984, 1987 by Stephen L. Moshier Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */ #include "mconf.h" #ifdef UNK #define MAXGAM 34.84425627277176174 #endif #ifdef DEC #define MAXGAM 34.84425627277176174 #endif #ifdef IBMPC #define MAXGAM 171.624376956302725 #endif #ifdef MIEEE #define MAXGAM 171.624376956302725 #endif #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_gamma ( double ); extern double lgam ( double ); extern double md_exp ( double ); extern double md_log ( double ); extern double md_floor ( double ); #else double md_fabs(), md_gamma(), lgam(), md_exp(), md_log(), md_floor(); #endif extern double MAXLOG, MAXNUM; extern int sgngam; double beta( a, b ) double a, b; { double y; int sign; sign = 1; if( a <= 0.0 ) { if( a == md_floor(a) ) goto over; } if( b <= 0.0 ) { if( b == md_floor(b) ) goto over; } y = a + b; if( md_fabs(y) > MAXGAM ) { y = lgam(y); sign *= sgngam; /* keep track of the sign */ y = lgam(b) - y; sign *= sgngam; y = lgam(a) + y; sign *= sgngam; if( y > MAXLOG ) { over: mtherr( "beta", OVERFLOW ); return( sign * MAXNUM ); } return( sign * md_exp(y) ); } y = md_gamma(y); if( y == 0.0 ) goto over; if( a > b ) { y = md_gamma(a)/y; y *= md_gamma(b); } else { y = md_gamma(b)/y; y *= md_gamma(a); } return(y); } /* Natural md_log of |beta|. Return the sign of beta in sgngam. */ double lbeta( a, b ) double a, b; { double y; int sign; sign = 1; if( a <= 0.0 ) { if( a == md_floor(a) ) goto over; } if( b <= 0.0 ) { if( b == md_floor(b) ) goto over; } y = a + b; if( md_fabs(y) > MAXGAM ) { y = lgam(y); sign *= sgngam; /* keep track of the sign */ y = lgam(b) - y; sign *= sgngam; y = lgam(a) + y; sign *= sgngam; sgngam = sign; return( y ); } y = md_gamma(y); if( y == 0.0 ) { over: mtherr( "lbeta", OVERFLOW ); return( sign * MAXNUM ); } if( a > b ) { y = md_gamma(a)/y; y *= md_gamma(b); } else { y = md_gamma(b)/y; y *= md_gamma(a); } if( y < 0 ) { sgngam = -1; y = -y; } else sgngam = 1; return( md_log(y) ); } Math-Cephes-0.5306/libmd/sqrt.spa0000644000175000017500000000026214757021403016361 0ustar shlomifshlomif.text .align 4 .global _sqrt .proc 07 _sqrt: !#PROLOGUE# 0 save %sp,-112,%sp !#PROLOGUE# 1 !#PROLOGUE# 1 std %i0,[%fp-16] ldd [%fp-16],%f4 fsqrtd %f4,%f0 ret restore Math-Cephes-0.5306/libmd/fresnl.c0000644000175000017500000003000114757021403016312 0ustar shlomifshlomif/* fresnl.c * * Fresnel integral * * * * SYNOPSIS: * * double x, S, C; * void fresnl(); * * fresnl( x, _&S, _&C ); * * * DESCRIPTION: * * Evaluates the Fresnel integrals * * x * - * | | * C(x) = | md_cos(pi/2 t**2) dt, * | | * - * 0 * * x * - * | | * S(x) = | md_sin(pi/2 t**2) dt. * | | * - * 0 * * * The integrals are evaluated by a power series for x < 1. * For x >= 1 auxiliary functions f(x) and g(x) are employed * such that * * C(x) = 0.5 + f(x) md_sin( pi/2 x**2 ) - g(x) md_cos( pi/2 x**2 ) * S(x) = 0.5 - f(x) md_cos( pi/2 x**2 ) - g(x) md_sin( pi/2 x**2 ) * * * * ACCURACY: * * Relative error. * * Arithmetic function domain # trials peak rms * IEEE S(x) 0, 10 10000 2.0e-15 3.2e-16 * IEEE C(x) 0, 10 10000 1.8e-15 3.3e-16 * DEC S(x) 0, 10 6000 2.2e-16 3.9e-17 * DEC C(x) 0, 10 5000 2.3e-16 3.9e-17 */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier */ #include "mconf.h" /* S(x) for small x */ #ifdef UNK static double sn[6] = { -2.99181919401019853726E3, 7.08840045257738576863E5, -6.29741486205862506537E7, 2.54890880573376359104E9, -4.42979518059697779103E10, 3.18016297876567817986E11, }; static double sd[6] = { /* 1.00000000000000000000E0,*/ 2.81376268889994315696E2, 4.55847810806532581675E4, 5.17343888770096400730E6, 4.19320245898111231129E8, 2.24411795645340920940E10, 6.07366389490084639049E11, }; #endif #ifdef DEC static unsigned short sn[24] = { 0143072,0176433,0065455,0127034, 0045055,0007200,0134540,0026661, 0146560,0035061,0023667,0127545, 0050027,0166503,0002673,0153756, 0151045,0002721,0121737,0102066, 0051624,0013177,0033451,0021271, }; static unsigned short sd[24] = { /*0040200,0000000,0000000,0000000,*/ 0042214,0130051,0112070,0101617, 0044062,0010307,0172346,0152510, 0045635,0160575,0143200,0136642, 0047307,0171215,0127457,0052361, 0050647,0031447,0032621,0013510, 0052015,0064733,0117362,0012653, }; #endif #ifdef IBMPC static unsigned short sn[24] = { 0xb5c3,0x6d65,0x5fa3,0xc0a7, 0x05b6,0x172c,0xa1d0,0x4125, 0xf5ed,0x24f6,0x0746,0xc18e, 0x7afe,0x60b7,0xfda8,0x41e2, 0xf087,0x347b,0xa0ba,0xc224, 0x2457,0xe6e5,0x82cf,0x4252, }; static unsigned short sd[24] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x1072,0x3287,0x9605,0x4071, 0xdaa9,0xfe9c,0x4218,0x40e6, 0x17b4,0xb8d0,0xbc2f,0x4153, 0xea9e,0xb5e5,0xfe51,0x41b8, 0x22e9,0xe6b2,0xe664,0x4214, 0x42b5,0x73de,0xad3b,0x4261, }; #endif #ifdef MIEEE static unsigned short sn[24] = { 0xc0a7,0x5fa3,0x6d65,0xb5c3, 0x4125,0xa1d0,0x172c,0x05b6, 0xc18e,0x0746,0x24f6,0xf5ed, 0x41e2,0xfda8,0x60b7,0x7afe, 0xc224,0xa0ba,0x347b,0xf087, 0x4252,0x82cf,0xe6e5,0x2457, }; static unsigned short sd[24] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x4071,0x9605,0x3287,0x1072, 0x40e6,0x4218,0xfe9c,0xdaa9, 0x4153,0xbc2f,0xb8d0,0x17b4, 0x41b8,0xfe51,0xb5e5,0xea9e, 0x4214,0xe664,0xe6b2,0x22e9, 0x4261,0xad3b,0x73de,0x42b5, }; #endif /* C(x) for small x */ #ifdef UNK static double cn[6] = { -4.98843114573573548651E-8, 9.50428062829859605134E-6, -6.45191435683965050962E-4, 1.88843319396703850064E-2, -2.05525900955013891793E-1, 9.99999999999999998822E-1, }; static double cd[7] = { 3.99982968972495980367E-12, 9.15439215774657478799E-10, 1.25001862479598821474E-7, 1.22262789024179030997E-5, 8.68029542941784300606E-4, 4.12142090722199792936E-2, 1.00000000000000000118E0, }; #endif #ifdef DEC static unsigned short cn[24] = { 0132126,0040141,0063733,0013231, 0034037,0072223,0010200,0075637, 0135451,0021020,0073264,0036057, 0036632,0131520,0101316,0060233, 0137522,0072541,0136124,0132202, 0040200,0000000,0000000,0000000, }; static unsigned short cd[28] = { 0026614,0135503,0051776,0032631, 0030573,0121116,0154033,0126712, 0032406,0034100,0012442,0106212, 0034115,0017567,0150520,0164623, 0035543,0106171,0177336,0146351, 0037050,0150073,0000607,0171635, 0040200,0000000,0000000,0000000, }; #endif #ifdef IBMPC static unsigned short cn[24] = { 0x62d3,0x2cfb,0xc80c,0xbe6a, 0x0f74,0x6210,0xee92,0x3ee3, 0x8786,0x0ed6,0x2442,0xbf45, 0xcc13,0x1059,0x566a,0x3f93, 0x9690,0x378a,0x4eac,0xbfca, 0x0000,0x0000,0x0000,0x3ff0, }; static unsigned short cd[28] = { 0xc6b3,0x6a7f,0x9768,0x3d91, 0x75b9,0xdb03,0x7449,0x3e0f, 0x5191,0x02a4,0xc708,0x3e80, 0x1d32,0xfa2a,0xa3ee,0x3ee9, 0xd99d,0x3fdb,0x718f,0x3f4c, 0xfe74,0x6030,0x1a07,0x3fa5, 0x0000,0x0000,0x0000,0x3ff0, }; #endif #ifdef MIEEE static unsigned short cn[24] = { 0xbe6a,0xc80c,0x2cfb,0x62d3, 0x3ee3,0xee92,0x6210,0x0f74, 0xbf45,0x2442,0x0ed6,0x8786, 0x3f93,0x566a,0x1059,0xcc13, 0xbfca,0x4eac,0x378a,0x9690, 0x3ff0,0x0000,0x0000,0x0000, }; static unsigned short cd[28] = { 0x3d91,0x9768,0x6a7f,0xc6b3, 0x3e0f,0x7449,0xdb03,0x75b9, 0x3e80,0xc708,0x02a4,0x5191, 0x3ee9,0xa3ee,0xfa2a,0x1d32, 0x3f4c,0x718f,0x3fdb,0xd99d, 0x3fa5,0x1a07,0x6030,0xfe74, 0x3ff0,0x0000,0x0000,0x0000, }; #endif /* Auxiliary function f(x) */ #ifdef UNK static double fn[10] = { 4.21543555043677546506E-1, 1.43407919780758885261E-1, 1.15220955073585758835E-2, 3.45017939782574027900E-4, 4.63613749287867322088E-6, 3.05568983790257605827E-8, 1.02304514164907233465E-10, 1.72010743268161828879E-13, 1.34283276233062758925E-16, 3.76329711269987889006E-20, }; static double fd[10] = { /* 1.00000000000000000000E0,*/ 7.51586398353378947175E-1, 1.16888925859191382142E-1, 6.44051526508858611005E-3, 1.55934409164153020873E-4, 1.84627567348930545870E-6, 1.12699224763999035261E-8, 3.60140029589371370404E-11, 5.88754533621578410010E-14, 4.52001434074129701496E-17, 1.25443237090011264384E-20, }; #endif #ifdef DEC static unsigned short fn[40] = { 0037727,0152216,0106601,0016214, 0037422,0154606,0112710,0071355, 0036474,0143453,0154253,0166545, 0035264,0161606,0022250,0073743, 0033633,0110036,0024653,0136246, 0032003,0036652,0041164,0036413, 0027740,0174122,0046305,0036726, 0025501,0125270,0121317,0167667, 0023032,0150555,0076175,0047443, 0020061,0133570,0070130,0027657, }; static unsigned short fd[40] = { /*0040200,0000000,0000000,0000000,*/ 0040100,0063767,0054413,0151452, 0037357,0061566,0007243,0065754, 0036323,0005365,0033552,0133625, 0035043,0101123,0000275,0165402, 0033367,0146614,0110623,0023647, 0031501,0116644,0125222,0144263, 0027436,0062051,0117235,0001411, 0025204,0111543,0056370,0036201, 0022520,0071351,0015227,0122144, 0017554,0172240,0112713,0005006, }; #endif #ifdef IBMPC static unsigned short fn[40] = { 0x2391,0xd1b0,0xfa91,0x3fda, 0x0e5e,0xd2b9,0x5b30,0x3fc2, 0x7dad,0x7b15,0x98e5,0x3f87, 0x0efc,0xc495,0x9c70,0x3f36, 0x7795,0xc535,0x7203,0x3ed3, 0x87a1,0x484e,0x67b5,0x3e60, 0xa7bb,0x4998,0x1f0a,0x3ddc, 0xfdf7,0x1459,0x3557,0x3d48, 0xa9e4,0xaf8f,0x5a2d,0x3ca3, 0x05f6,0x0e0b,0x36ef,0x3be6, }; static unsigned short fd[40] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x7a65,0xeb21,0x0cfe,0x3fe8, 0x6d7d,0xc1d4,0xec6e,0x3fbd, 0x56f3,0xa6ed,0x615e,0x3f7a, 0xbd60,0x6017,0x704a,0x3f24, 0x64f5,0x9232,0xf9b1,0x3ebe, 0x5916,0x9552,0x33b4,0x3e48, 0xa061,0x33d3,0xcc85,0x3dc3, 0x0790,0x6b9f,0x926c,0x3d30, 0xf48d,0x2352,0x0e5d,0x3c8a, 0x6141,0x12b9,0x9e94,0x3bcd, }; #endif #ifdef MIEEE static unsigned short fn[40] = { 0x3fda,0xfa91,0xd1b0,0x2391, 0x3fc2,0x5b30,0xd2b9,0x0e5e, 0x3f87,0x98e5,0x7b15,0x7dad, 0x3f36,0x9c70,0xc495,0x0efc, 0x3ed3,0x7203,0xc535,0x7795, 0x3e60,0x67b5,0x484e,0x87a1, 0x3ddc,0x1f0a,0x4998,0xa7bb, 0x3d48,0x3557,0x1459,0xfdf7, 0x3ca3,0x5a2d,0xaf8f,0xa9e4, 0x3be6,0x36ef,0x0e0b,0x05f6, }; static unsigned short fd[40] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x3fe8,0x0cfe,0xeb21,0x7a65, 0x3fbd,0xec6e,0xc1d4,0x6d7d, 0x3f7a,0x615e,0xa6ed,0x56f3, 0x3f24,0x704a,0x6017,0xbd60, 0x3ebe,0xf9b1,0x9232,0x64f5, 0x3e48,0x33b4,0x9552,0x5916, 0x3dc3,0xcc85,0x33d3,0xa061, 0x3d30,0x926c,0x6b9f,0x0790, 0x3c8a,0x0e5d,0x2352,0xf48d, 0x3bcd,0x9e94,0x12b9,0x6141, }; #endif /* Auxiliary function g(x) */ #ifdef UNK static double gn[11] = { 5.04442073643383265887E-1, 1.97102833525523411709E-1, 1.87648584092575249293E-2, 6.84079380915393090172E-4, 1.15138826111884280931E-5, 9.82852443688422223854E-8, 4.45344415861750144738E-10, 1.08268041139020870318E-12, 1.37555460633261799868E-15, 8.36354435630677421531E-19, 1.86958710162783235106E-22, }; static double gd[11] = { /* 1.00000000000000000000E0,*/ 1.47495759925128324529E0, 3.37748989120019970451E-1, 2.53603741420338795122E-2, 8.14679107184306179049E-4, 1.27545075667729118702E-5, 1.04314589657571990585E-7, 4.60680728146520428211E-10, 1.10273215066240270757E-12, 1.38796531259578871258E-15, 8.39158816283118707363E-19, 1.86958710162783236342E-22, }; #endif #ifdef DEC static unsigned short gn[44] = { 0040001,0021435,0120406,0053123, 0037511,0152523,0037703,0122011, 0036631,0134302,0122721,0110235, 0035463,0051712,0043215,0114732, 0034101,0025677,0147725,0057630, 0032323,0010342,0067523,0002206, 0030364,0152247,0110007,0054107, 0026230,0057654,0035464,0047124, 0023706,0036401,0167705,0045440, 0021166,0154447,0105632,0142461, 0016142,0002353,0011175,0170530, }; static unsigned short gd[44] = { /*0040200,0000000,0000000,0000000,*/ 0040274,0145551,0016742,0127005, 0037654,0166557,0076416,0015165, 0036717,0140217,0030675,0050111, 0035525,0110060,0076405,0070502, 0034125,0176061,0060120,0031730, 0032340,0001615,0054343,0120501, 0030375,0041414,0070747,0107060, 0026233,0031034,0160757,0074526, 0023710,0003341,0137100,0144664, 0021167,0126414,0023774,0015435, 0016142,0002353,0011175,0170530, }; #endif #ifdef IBMPC static unsigned short gn[44] = { 0xcaca,0xb420,0x2463,0x3fe0, 0x7481,0x67f8,0x3aaa,0x3fc9, 0x3214,0x54ba,0x3718,0x3f93, 0xb33b,0x48d1,0x6a79,0x3f46, 0xabf3,0xf9fa,0x2577,0x3ee8, 0x6091,0x4dea,0x621c,0x3e7a, 0xeb09,0xf200,0x9a94,0x3dfe, 0x89cb,0x8766,0x0bf5,0x3d73, 0xa964,0x3df8,0xc7a0,0x3cd8, 0x58a6,0xf173,0xdb24,0x3c2e, 0xbe2b,0x624f,0x409d,0x3b6c, }; static unsigned short gd[44] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x55c1,0x23bc,0x996d,0x3ff7, 0xc34f,0xefa1,0x9dad,0x3fd5, 0xaa09,0xe637,0xf811,0x3f99, 0xae28,0x0fa0,0xb206,0x3f4a, 0x067b,0x2c0a,0xbf86,0x3eea, 0x7428,0xab1c,0x0071,0x3e7c, 0xf1c6,0x8e3c,0xa861,0x3dff, 0xef2b,0x9c3d,0x6643,0x3d73, 0x1936,0x37c8,0x00dc,0x3cd9, 0x8364,0x84ff,0xf5a1,0x3c2e, 0xbe2b,0x624f,0x409d,0x3b6c, }; #endif #ifdef MIEEE static unsigned short gn[44] = { 0x3fe0,0x2463,0xb420,0xcaca, 0x3fc9,0x3aaa,0x67f8,0x7481, 0x3f93,0x3718,0x54ba,0x3214, 0x3f46,0x6a79,0x48d1,0xb33b, 0x3ee8,0x2577,0xf9fa,0xabf3, 0x3e7a,0x621c,0x4dea,0x6091, 0x3dfe,0x9a94,0xf200,0xeb09, 0x3d73,0x0bf5,0x8766,0x89cb, 0x3cd8,0xc7a0,0x3df8,0xa964, 0x3c2e,0xdb24,0xf173,0x58a6, 0x3b6c,0x409d,0x624f,0xbe2b, }; static unsigned short gd[44] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0x3ff7,0x996d,0x23bc,0x55c1, 0x3fd5,0x9dad,0xefa1,0xc34f, 0x3f99,0xf811,0xe637,0xaa09, 0x3f4a,0xb206,0x0fa0,0xae28, 0x3eea,0xbf86,0x2c0a,0x067b, 0x3e7c,0x0071,0xab1c,0x7428, 0x3dff,0xa861,0x8e3c,0xf1c6, 0x3d73,0x6643,0x9c3d,0xef2b, 0x3cd9,0x00dc,0x37c8,0x1936, 0x3c2e,0xf5a1,0x84ff,0x8364, 0x3b6c,0x409d,0x624f,0xbe2b, }; #endif #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_cos ( double ); extern double md_sin ( double ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); #else double md_fabs(), md_cos(), md_sin(), polevl(), p1evl(); #endif extern double PI, PIO2, MACHEP; int fresnl( xxa, ssa, cca ) double xxa, *ssa, *cca; { double f, g, cc, ss, c, s, t, u; double x, x2; x = md_fabs(xxa); x2 = x * x; if( x2 < 2.5625 ) { t = x2 * x2; ss = x * x2 * polevl( t, sn, 5)/p1evl( t, sd, 6 ); cc = x * polevl( t, cn, 5)/polevl(t, cd, 6 ); goto done; } if( x > 36974.0 ) { cc = 0.5; ss = 0.5; goto done; } /* Asymptotic power series auxiliary functions * for large argument */ x2 = x * x; t = PI * x2; u = 1.0/(t * t); t = 1.0/t; f = 1.0 - u * polevl( u, fn, 9)/p1evl(u, fd, 10); g = t * polevl( u, gn, 10)/p1evl(u, gd, 11); t = PIO2 * x2; c = md_cos(t); s = md_sin(t); t = PI * x; cc = 0.5 + (f * s - g * c)/t; ss = 0.5 - (f * c + g * s)/t; done: if( xxa < 0.0 ) { cc = -cc; ss = -ss; } *cca = cc; *ssa = ss; return(0); } Math-Cephes-0.5306/libmd/chdtr.c0000644000175000017500000000663614757021403016146 0ustar shlomifshlomif/* chdtr.c * * Chi-square distribution * * * * SYNOPSIS: * * double df, x, y, chdtr(); * * y = chdtr( df, x ); * * * * DESCRIPTION: * * Returns the area under the left hand tail (from 0 to x) * of the Chi square probability density function with * v degrees of freedom. * * * inf. * - * 1 | | v/2-1 -t/2 * P( x | v ) = ----------- | t e dt * v/2 - | | * 2 | (v/2) - * x * * where x is the Chi-square variable. * * The incomplete md_gamma integral is used, according to the * formula * * y = chdtr( v, x ) = igam( v/2.0, x/2.0 ). * * * The arguments must both be positive. * * * * ACCURACY: * * See igam(). * * ERROR MESSAGES: * * message condition value returned * chdtr domain x < 0 or v < 1 0.0 */ /* chdtrc() * * Complemented Chi-square distribution * * * * SYNOPSIS: * * double v, x, y, chdtrc(); * * y = chdtrc( v, x ); * * * * DESCRIPTION: * * Returns the area under the right hand tail (from x to * infinity) of the Chi square probability density function * with v degrees of freedom: * * * inf. * - * 1 | | v/2-1 -t/2 * P( x | v ) = ----------- | t e dt * v/2 - | | * 2 | (v/2) - * x * * where x is the Chi-square variable. * * The incomplete md_gamma integral is used, according to the * formula * * y = chdtr( v, x ) = igamc( v/2.0, x/2.0 ). * * * The arguments must both be positive. * * * * ACCURACY: * * See igamc(). * * ERROR MESSAGES: * * message condition value returned * chdtrc domain x < 0 or v < 1 0.0 */ /* chdtri() * * Inverse of complemented Chi-square distribution * * * * SYNOPSIS: * * double df, x, y, chdtri(); * * x = chdtri( df, y ); * * * * * DESCRIPTION: * * Finds the Chi-square argument x such that the integral * from x to infinity of the Chi-square density is equal * to the given cumulative probability y. * * This is accomplished using the inverse md_gamma integral * function and the relation * * x/2 = igami( df/2, y ); * * * * * ACCURACY: * * See igami.c. * * ERROR MESSAGES: * * message condition value returned * chdtri domain y < 0 or y > 1 0.0 * v < 1 * */ /* chdtr() */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double igamc ( double, double ); extern double igam ( double, double ); extern double igami ( double, double ); #else double igamc(), igam(), igami(); #endif double chdtrc(df,x) double df, x; { if( (x < 0.0) || (df < 1.0) ) { mtherr( "chdtrc", DOMAIN ); return(0.0); } return( igamc( df/2.0, x/2.0 ) ); } double chdtr(df,x) double df, x; { if( (x < 0.0) || (df < 1.0) ) { mtherr( "chdtr", DOMAIN ); return(0.0); } return( igam( df/2.0, x/2.0 ) ); } double chdtri( df, y ) double df, y; { double x; if( (y < 0.0) || (y > 1.0) || (df < 1.0) ) { mtherr( "chdtri", DOMAIN ); return(0.0); } x = igami( 0.5 * df, y ); return( 2.0 * x ); } Math-Cephes-0.5306/libmd/drand.c0000644000175000017500000000610214757021403016116 0ustar shlomifshlomif/* drand.c * * Pseudorandom number generator * * * * SYNOPSIS: * * double y, drand(); * * drand( &y ); * * * * DESCRIPTION: * * Yields a random number 1.0 <= y < 2.0. * * The three-generator congruential algorithm by Brian * Wichmann and David Hill (BYTE magazine, March, 1987, * pp 127-8) is used. The period, given by them, is * 6953607871644. * * Versions invoked by the different arithmetic compile * time options DEC, IBMPC, and MIEEE, produce * approximately the same sequences, differing only in the * least significant bits of the numbers. The UNK option * implements the algorithm as recommended in the BYTE * article. It may be used on all computers. However, * the low order bits of a double precision number may * not be adequately random, and may vary due to arithmetic * implementation details on different computers. * * The other compile options generate an additional random * integer that overwrites the low order bits of the double * precision number. This reduces the period by a factor of * two but tends to overcome the problems mentioned. * */ /* Three-generator random number algorithm * of Brian Wichmann and David Hill * BYTE magazine, March, 1987 pp 127-8 * * The period, given by them, is (p-1)(q-1)(r-1)/4 = 6.95e12. */ #include "mconf.h" #ifdef ANSIPROT static int ranwh ( void ); #else static int ranwh(); #endif static int sx = 1; static int sy = 10000; static int sz = 3000; static union { double d; unsigned short s[4]; } unkans; /* This function implements the three * congruential generators. */ static int ranwh() { int r, s; /* sx = sx * 171 mod 30269 */ r = sx/177; s = sx - 177 * r; sx = 171 * s - 2 * r; if( sx < 0 ) sx += 30269; /* sy = sy * 172 mod 30307 */ r = sy/176; s = sy - 176 * r; sy = 172 * s - 35 * r; if( sy < 0 ) sy += 30307; /* sz = 170 * sz mod 30323 */ r = sz/178; s = sz - 178 * r; sz = 170 * s - 63 * r; if( sz < 0 ) sz += 30323; /* The results are in static sx, sy, sz. */ return 0; } /* drand.c * * Random double precision floating point number between 1 and 2. * * C callable: * drand( &x ); */ int drand( a ) double *a; { unsigned short r; #ifdef DEC unsigned short s, t; #endif /* This algorithm of Wichmann and Hill computes a floating point * result: */ ranwh(); unkans.d = sx/30269.0 + sy/30307.0 + sz/30323.0; r = unkans.d; unkans.d -= r; unkans.d += 1.0; /* if UNK option, do nothing further. * Otherwise, make a random 16 bit integer * to overwrite the least significant word * of unkans. */ #ifdef UNK /* do nothing */ #else ranwh(); r = sx * sy + sz; #endif #ifdef DEC /* To make the numbers as similar as possible * in all arithmetics, the random integer has * to be inserted 3 bits higher up in a DEC number. * An alternative would be put it 3 bits lower down * in all the other number types. */ s = unkans.s[2]; t = s & 07; /* save these bits to put in at the bottom */ s &= 0177770; s |= (r >> 13) & 07; unkans.s[2] = s; t |= r << 3; unkans.s[3] = t; #endif #ifdef IBMPC unkans.s[0] = r; #endif #ifdef MIEEE unkans.s[3] = r; #endif *a = unkans.d; return 0; } Math-Cephes-0.5306/libmd/dawsn.c0000644000175000017500000002223014757021403016142 0ustar shlomifshlomif/* dawsn.c * * Dawson's Integral * * * * SYNOPSIS: * * double x, y, dawsn(); * * y = dawsn( x ); * * * * DESCRIPTION: * * Approximates the integral * * x * - * 2 | | 2 * dawsn(x) = md_exp( -x ) | md_exp( t ) dt * | | * - * 0 * * Three different rational approximations are employed, for * the intervals 0 to 3.25; 3.25 to 6.25; and 6.25 up. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0,10 10000 6.9e-16 1.0e-16 * DEC 0,10 6000 7.4e-17 1.4e-17 * * */ /* dawsn.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier */ #include "mconf.h" /* Dawson's integral, interval 0 to 3.25 */ #ifdef UNK static double AN[10] = { 1.13681498971755972054E-11, 8.49262267667473811108E-10, 1.94434204175553054283E-8, 9.53151741254484363489E-7, 3.07828309874913200438E-6, 3.52513368520288738649E-4, -8.50149846724410912031E-4, 4.22618223005546594270E-2, -9.17480371773452345351E-2, 9.99999999999999994612E-1, }; static double AD[11] = { 2.40372073066762605484E-11, 1.48864681368493396752E-9, 5.21265281010541664570E-8, 1.27258478273186970203E-6, 2.32490249820789513991E-5, 3.25524741826057911661E-4, 3.48805814657162590916E-3, 2.79448531198828973716E-2, 1.58874241960120565368E-1, 5.74918629489320327824E-1, 1.00000000000000000539E0, }; #endif #ifdef DEC static unsigned short AN[40] = { 0027107,0176630,0075752,0107612, 0030551,0070604,0166707,0127727, 0031647,0002210,0117120,0056376, 0033177,0156026,0141275,0140627, 0033516,0112200,0037035,0165515, 0035270,0150613,0016423,0105634, 0135536,0156227,0023515,0044413, 0037055,0015273,0105147,0064025, 0137273,0163145,0014460,0166465, 0040200,0000000,0000000,0000000, }; static unsigned short AD[44] = { 0027323,0067372,0115566,0131320, 0030714,0114432,0074206,0006637, 0032137,0160671,0044203,0026344, 0033252,0146656,0020247,0100231, 0034303,0003346,0123260,0022433, 0035252,0125460,0173041,0155415, 0036144,0113747,0125203,0124617, 0036744,0166232,0143671,0133670, 0037442,0127755,0162625,0000100, 0040023,0026736,0003604,0106265, 0040200,0000000,0000000,0000000, }; #endif #ifdef IBMPC static unsigned short AN[40] = { 0x51f1,0x0f7d,0xffb3,0x3da8, 0xf5fb,0x9db8,0x2e30,0x3e0d, 0x0ba0,0x13ca,0xe091,0x3e54, 0xb833,0xd857,0xfb82,0x3eaf, 0xbd6a,0x07c3,0xd290,0x3ec9, 0x7174,0x63a2,0x1a31,0x3f37, 0xa921,0xe4e9,0xdb92,0xbf4b, 0xed03,0x714c,0xa357,0x3fa5, 0x1da7,0xa326,0x7ccc,0xbfb7, 0x0000,0x0000,0x0000,0x3ff0, }; static unsigned short AD[44] = { 0xd65a,0x536e,0x6ddf,0x3dba, 0xc1b4,0x4f10,0x9323,0x3e19, 0x659c,0x2910,0xfc37,0x3e6b, 0xf013,0xc414,0x59b5,0x3eb5, 0x04a3,0xd4d6,0x60dc,0x3ef8, 0x3b62,0x1ec4,0x5566,0x3f35, 0x7532,0xf550,0x92fc,0x3f6c, 0x36f7,0x58f7,0x9d93,0x3f9c, 0xa008,0xbcb2,0x55fd,0x3fc4, 0x9197,0xc0f0,0x65bb,0x3fe2, 0x0000,0x0000,0x0000,0x3ff0, }; #endif #ifdef MIEEE static unsigned short AN[40] = { 0x3da8,0xffb3,0x0f7d,0x51f1, 0x3e0d,0x2e30,0x9db8,0xf5fb, 0x3e54,0xe091,0x13ca,0x0ba0, 0x3eaf,0xfb82,0xd857,0xb833, 0x3ec9,0xd290,0x07c3,0xbd6a, 0x3f37,0x1a31,0x63a2,0x7174, 0xbf4b,0xdb92,0xe4e9,0xa921, 0x3fa5,0xa357,0x714c,0xed03, 0xbfb7,0x7ccc,0xa326,0x1da7, 0x3ff0,0x0000,0x0000,0x0000, }; static unsigned short AD[44] = { 0x3dba,0x6ddf,0x536e,0xd65a, 0x3e19,0x9323,0x4f10,0xc1b4, 0x3e6b,0xfc37,0x2910,0x659c, 0x3eb5,0x59b5,0xc414,0xf013, 0x3ef8,0x60dc,0xd4d6,0x04a3, 0x3f35,0x5566,0x1ec4,0x3b62, 0x3f6c,0x92fc,0xf550,0x7532, 0x3f9c,0x9d93,0x58f7,0x36f7, 0x3fc4,0x55fd,0xbcb2,0xa008, 0x3fe2,0x65bb,0xc0f0,0x9197, 0x3ff0,0x0000,0x0000,0x0000, }; #endif /* interval 3.25 to 6.25 */ #ifdef UNK static double BN[11] = { 5.08955156417900903354E-1, -2.44754418142697847934E-1, 9.41512335303534411857E-2, -2.18711255142039025206E-2, 3.66207612329569181322E-3, -4.23209114460388756528E-4, 3.59641304793896631888E-5, -2.14640351719968974225E-6, 9.10010780076391431042E-8, -2.40274520828250956942E-9, 3.59233385440928410398E-11, }; static double BD[10] = { /* 1.00000000000000000000E0,*/ -6.31839869873368190192E-1, 2.36706788228248691528E-1, -5.31806367003223277662E-2, 8.48041718586295374409E-3, -9.47996768486665330168E-4, 7.81025592944552338085E-5, -4.55875153252442634831E-6, 1.89100358111421846170E-7, -4.91324691331920606875E-9, 7.18466403235734541950E-11, }; #endif #ifdef DEC static unsigned short BN[44] = { 0040002,0045342,0113762,0004360, 0137572,0120346,0172745,0144046, 0037300,0151134,0123440,0117047, 0136663,0025423,0014755,0046026, 0036157,0177561,0027535,0046744, 0135335,0161052,0071243,0146535, 0034426,0154060,0164506,0135625, 0133420,0005356,0100017,0151334, 0032303,0066137,0024013,0046212, 0131045,0016612,0066270,0047574, 0027435,0177025,0060625,0116363, }; static unsigned short BD[40] = { /*0040200,0000000,0000000,0000000,*/ 0140041,0140101,0174552,0037073, 0037562,0061503,0124271,0160756, 0137131,0151760,0073210,0110534, 0036412,0170562,0117017,0155377, 0135570,0101374,0074056,0037276, 0034643,0145376,0001516,0060636, 0133630,0173540,0121344,0155231, 0032513,0005602,0134516,0007144, 0131250,0150540,0075747,0105341, 0027635,0177020,0012465,0125402, }; #endif #ifdef IBMPC static unsigned short BN[44] = { 0x411e,0x52fe,0x495c,0x3fe0, 0xb905,0xdebc,0x541c,0xbfcf, 0x13c5,0x94e4,0x1a4b,0x3fb8, 0xa983,0x633d,0x6562,0xbf96, 0xa9bd,0x25eb,0xffee,0x3f6d, 0x79ac,0x4e54,0xbc45,0xbf3b, 0xd773,0x1d28,0xdb06,0x3f02, 0xfa5b,0xd001,0x015d,0xbec2, 0x6991,0xe501,0x6d8b,0x3e78, 0x09f0,0x4d97,0xa3b1,0xbe24, 0xb39e,0xac32,0xbfc2,0x3dc3, }; static unsigned short BD[40] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x47c7,0x3f2d,0x3808,0xbfe4, 0x3c3e,0x7517,0x4c68,0x3fce, 0x122b,0x0ed1,0x3a7e,0xbfab, 0xfb60,0x53c1,0x5e2e,0x3f81, 0xc7d8,0x8f05,0x105f,0xbf4f, 0xcc34,0xc069,0x795f,0x3f14, 0x9b53,0x145c,0x1eec,0xbed3, 0xc1cd,0x5729,0x6170,0x3e89, 0xf15c,0x0f7c,0x1a2c,0xbe35, 0xb560,0x02a6,0xbfc2,0x3dd3, }; #endif #ifdef MIEEE static unsigned short BN[44] = { 0x3fe0,0x495c,0x52fe,0x411e, 0xbfcf,0x541c,0xdebc,0xb905, 0x3fb8,0x1a4b,0x94e4,0x13c5, 0xbf96,0x6562,0x633d,0xa983, 0x3f6d,0xffee,0x25eb,0xa9bd, 0xbf3b,0xbc45,0x4e54,0x79ac, 0x3f02,0xdb06,0x1d28,0xd773, 0xbec2,0x015d,0xd001,0xfa5b, 0x3e78,0x6d8b,0xe501,0x6991, 0xbe24,0xa3b1,0x4d97,0x09f0, 0x3dc3,0xbfc2,0xac32,0xb39e, }; static unsigned short BD[40] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0xbfe4,0x3808,0x3f2d,0x47c7, 0x3fce,0x4c68,0x7517,0x3c3e, 0xbfab,0x3a7e,0x0ed1,0x122b, 0x3f81,0x5e2e,0x53c1,0xfb60, 0xbf4f,0x105f,0x8f05,0xc7d8, 0x3f14,0x795f,0xc069,0xcc34, 0xbed3,0x1eec,0x145c,0x9b53, 0x3e89,0x6170,0x5729,0xc1cd, 0xbe35,0x1a2c,0x0f7c,0xf15c, 0x3dd3,0xbfc2,0x02a6,0xb560, }; #endif /* 6.25 to infinity */ #ifdef UNK static double CN[5] = { -5.90592860534773254987E-1, 6.29235242724368800674E-1, -1.72858975380388136411E-1, 1.64837047825189632310E-2, -4.86827613020462700845E-4, }; static double CD[5] = { /* 1.00000000000000000000E0,*/ -2.69820057197544900361E0, 1.73270799045947845857E0, -3.93708582281939493482E-1, 3.44278924041233391079E-2, -9.73655226040941223894E-4, }; #endif #ifdef DEC static unsigned short CN[20] = { 0140027,0030427,0176477,0074402, 0040041,0012617,0112375,0162657, 0137461,0000761,0074120,0135160, 0036607,0004325,0117246,0115525, 0135377,0036345,0064750,0047732, }; static unsigned short CD[20] = { /*0040200,0000000,0000000,0000000,*/ 0140454,0127521,0071653,0133415, 0040335,0144540,0016105,0045241, 0137711,0112053,0155034,0062237, 0037015,0002102,0177442,0074546, 0135577,0036345,0064750,0052152, }; #endif #ifdef IBMPC static unsigned short CN[20] = { 0xef20,0xffa7,0xe622,0xbfe2, 0xbcb6,0xf29f,0x22b1,0x3fe4, 0x174e,0x2f0a,0x203e,0xbfc6, 0xd36b,0xb3d4,0xe11a,0x3f90, 0x09fb,0xad3d,0xe79c,0xbf3f, }; static unsigned short CD[20] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x76e2,0x2e75,0x95ea,0xc005, 0xa954,0x0388,0xb92c,0x3ffb, 0x8c94,0x7b43,0x3285,0xbfd9, 0x4f2d,0x5fe4,0xa088,0x3fa1, 0x0a8d,0xad3d,0xe79c,0xbf4f, }; #endif #ifdef MIEEE static unsigned short CN[20] = { 0xbfe2,0xe622,0xffa7,0xef20, 0x3fe4,0x22b1,0xf29f,0xbcb6, 0xbfc6,0x203e,0x2f0a,0x174e, 0x3f90,0xe11a,0xb3d4,0xd36b, 0xbf3f,0xe79c,0xad3d,0x09fb, }; static unsigned short CD[20] = { /*0x3ff0,0x0000,0x0000,0x0000,*/ 0xc005,0x95ea,0x2e75,0x76e2, 0x3ffb,0xb92c,0x0388,0xa954, 0xbfd9,0x3285,0x7b43,0x8c94, 0x3fa1,0xa088,0x5fe4,0x4f2d, 0xbf4f,0xe79c,0xad3d,0x0a8d, }; #endif #ifdef ANSIPROT extern double chbevl ( double, void *, int ); extern double sqrt ( double ); extern double md_fabs ( double ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); #else double chbevl(), sqrt(), md_fabs(), polevl(), p1evl(); #endif extern double PI, MACHEP; double dawsn( xx ) double xx; { double x, y; int sign; sign = 1; if( xx < 0.0 ) { sign = -1; xx = -xx; } if( xx < 3.25 ) { x = xx*xx; y = xx * polevl( x, AN, 9 )/polevl( x, AD, 10 ); return( sign * y ); } x = 1.0/(xx*xx); if( xx < 6.25 ) { y = 1.0/xx + x * polevl( x, BN, 10) / (p1evl( x, BD, 10) * xx); return( sign * 0.5 * y ); } if( xx > 1.0e9 ) return( (sign * 0.5)/xx ); /* 6.25 to infinity */ y = 1.0/xx + x * polevl( x, CN, 4) / (p1evl( x, CD, 5) * xx); return( sign * 0.5 * y ); } Math-Cephes-0.5306/libmd/setpmsvc.c.win320000644000175000017500000000114514757021403017635 0ustar shlomifshlomif/* Math coprocessor precision settings This version works with Microsoft Visual C++ version 6. */ int dprec() { __asm { push eax sub esp,4 fstcw [esp] fwait mov eax,[esp] and eax,0xfcf7 or eax,0x200 mov [esp],eax fldcw [esp] pop eax pop eax } return 0; } int sprec() { __asm { push eax sub esp,4 fstcw [esp] fwait mov eax,[esp] and eax,0xfcff mov [esp],eax fldcw [esp] pop eax pop eax } return 0; } int ldprec() { __asm { push eax sub esp,4 fstcw [esp] fwait mov eax,[esp] or eax,0x300 mov [esp],eax fldcw [esp] pop eax pop eax } return 0; } Math-Cephes-0.5306/libmd/fabs.c0000644000175000017500000000113014757021403015735 0ustar shlomifshlomif/* md_fabs.c * * Absolute value * * * * SYNOPSIS: * * double x, y; * * y = md_fabs( x ); * * * * DESCRIPTION: * * Returns the absolute value of the argument. * */ #include "mconf.h" /* Avoid using UNK if possible. */ #ifdef UNK #if BIGENDIAN #define MIEEE 1 #else #define IBMPC 1 #endif #endif double md_fabs(x) double x; { union { double d; short i[4]; } u; u.d = x; #ifdef IBMPC u.i[3] &= 0x7fff; #endif #ifdef MIEEE u.i[0] &= 0x7fff; #endif #ifdef DEC u.i[3] &= 0x7fff; #endif #ifdef UNK if( u.d < 0 ) u.d = -u.d; #endif return( u.d ); } Math-Cephes-0.5306/libmd/simpsn_wrap.c0000644000175000017500000000110614757021403017367 0ustar shlomifshlomif/* simpsn.c */ /* simpsn_wrap.c * wrapper for simpsn.c */ #include "mconf.h" #include #ifdef ANSIPROT extern void * malloc ( long ); extern void free ( void * ); #else void * malloc(); void free (); #endif extern double simpsn( double f[], double h); double simpsn_wrap( f, n, h ) double f[]; /* tabulated function */ int n; double h; { double ans=0.0, *g; int j, k; g = (double *) malloc( 9 * sizeof (double) ); for (j=0; j 0 ); ans = x/ans; /* backward recurrence */ pk = 1.0; pkm1 = 1.0/ans; k = n-1; r = 2 * k; do { pkm2 = (pkm1 * r - pk * x) / x; pk = pkm1; pkm1 = pkm2; r -= 2.0; } while( --k > 0 ); if( md_fabs(pk) > md_fabs(pkm1) ) ans = md_j1(x)/pk; else ans = md_j0(x)/pkm1; return( sign * ans ); } Math-Cephes-0.5306/libmd/sindg.c0000644000175000017500000001375614757021403016147 0ustar shlomifshlomif/* md_sindg.c * * Circular sine of angle in degrees * * * * SYNOPSIS: * * double x, y, md_sindg(); * * y = md_sindg( x ); * * * * DESCRIPTION: * * Range reduction is into intervals of 45 degrees. * * Two polynomial approximating functions are employed. * Between 0 and pi/4 the sine is approximated by * x + x**3 P(x**2). * Between pi/4 and pi/2 the cosine is represented as * 1 - x**2 P(x**2). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC +-1000 3100 3.3e-17 9.0e-18 * IEEE +-1000 30000 2.3e-16 5.6e-17 * * ERROR MESSAGES: * * message condition value returned * md_sindg total loss x > 8.0e14 (DEC) 0.0 * x > 1.0e14 (IEEE) * */ /* cosdg.c * * Circular cosine of angle in degrees * * * * SYNOPSIS: * * double x, y, cosdg(); * * y = cosdg( x ); * * * * DESCRIPTION: * * Range reduction is into intervals of 45 degrees. * * Two polynomial approximating functions are employed. * Between 0 and pi/4 the cosine is approximated by * 1 - x**2 P(x**2). * Between pi/4 and pi/2 the sine is represented as * x + x**3 P(x**2). * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC +-1000 3400 3.5e-17 9.1e-18 * IEEE +-1000 30000 2.1e-16 5.7e-17 * See also md_sin(). * */ /* Cephes Math Library Release 2.0: April, 1987 * Copyright 1985, 1987 by Stephen L. Moshier * Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */ #include "mconf.h" #ifdef UNK static double sincof[] = { 1.58962301572218447952E-10, -2.50507477628503540135E-8, 2.75573136213856773549E-6, -1.98412698295895384658E-4, 8.33333333332211858862E-3, -1.66666666666666307295E-1 }; static double coscof[] = { 1.13678171382044553091E-11, -2.08758833757683644217E-9, 2.75573155429816611547E-7, -2.48015872936186303776E-5, 1.38888888888806666760E-3, -4.16666666666666348141E-2, 4.99999999999999999798E-1 }; static double PI180 = 1.74532925199432957692E-2; /* pi/180 */ static double lossth = 1.0e14; #endif #ifdef DEC static unsigned short sincof[] = { 0030056,0143750,0177170,0073013, 0131727,0027455,0044510,0132205, 0033470,0167432,0131752,0042263, 0135120,0006400,0146776,0174027, 0036410,0104210,0104207,0137202, 0137452,0125252,0125252,0125103 }; static unsigned short coscof[] = { 0027107,0176030,0153315,0110312, 0131017,0072476,0007450,0123243, 0032623,0171174,0070066,0146445, 0134320,0006400,0147355,0163313, 0035666,0005540,0133012,0165067, 0137052,0125252,0125252,0125206, 0040000,0000000,0000000,0000000 }; static unsigned short P1[] = {0036616,0175065,0011224,0164711}; #define PI180 *(double *)P1 static double lossth = 8.0e14; #endif #ifdef IBMPC static unsigned short sincof[] = { 0x0ec1,0x1fcf,0xd8fd,0x3de5, 0x1691,0xa929,0xe5e5,0xbe5a, 0x4896,0x567d,0x1de3,0x3ec7, 0xdf03,0x19bf,0x01a0,0xbf2a, 0xf7d0,0x1110,0x1111,0x3f81, 0x5548,0x5555,0x5555,0xbfc5 }; static unsigned short coscof[] = { 0xb219,0x1ad9,0xff83,0x3da8, 0x14d4,0xc1e5,0xeea7,0xbe21, 0xd9a5,0x8e06,0x7e4f,0x3e92, 0xbcd9,0x19dd,0x01a0,0xbefa, 0x5d47,0x16c1,0xc16c,0x3f56, 0x5551,0x5555,0x5555,0xbfa5, 0x0000,0x0000,0x0000,0x3fe0 }; static unsigned short P1[] = {0x9d39,0xa252,0xdf46,0x3f91}; #define PI180 *(double *)P1 static double lossth = 1.0e14; #endif #ifdef MIEEE static unsigned short sincof[] = { 0x3de5,0xd8fd,0x1fcf,0x0ec1, 0xbe5a,0xe5e5,0xa929,0x1691, 0x3ec7,0x1de3,0x567d,0x4896, 0xbf2a,0x01a0,0x19bf,0xdf03, 0x3f81,0x1111,0x1110,0xf7d0, 0xbfc5,0x5555,0x5555,0x5548 }; static unsigned short coscof[] = { 0x3da8,0xff83,0x1ad9,0xb219, 0xbe21,0xeea7,0xc1e5,0x14d4, 0x3e92,0x7e4f,0x8e06,0xd9a5, 0xbefa,0x01a0,0x19dd,0xbcd9, 0x3f56,0xc16c,0x16c1,0x5d47, 0xbfa5,0x5555,0x5555,0x5551, 0x3fe0,0x0000,0x0000,0x0000 }; static unsigned short P1[] = { 0x3f91,0xdf46,0xa252,0x9d39 }; #define PI180 *(double *)P1 static double lossth = 1.0e14; #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double md_floor ( double ); extern double md_ldexp ( double, int ); #else double polevl(), md_floor(), md_ldexp(); #endif extern double PIO4; double md_sindg(x) double x; { double y, z, zz; int j, sign; /* make argument positive but save the sign */ sign = 1; if( x < 0 ) { x = -x; sign = -1; } if( x > lossth ) { mtherr( "md_sindg", TLOSS ); return(0.0); } y = md_floor( x/45.0 ); /* integer part of x/PIO4 */ /* strip high bits of integer part to prevent integer overflow */ z = md_ldexp( y, -4 ); z = md_floor(z); /* integer part of y/8 */ z = y - md_ldexp( z, 4 ); /* y - 16 * (y/16) */ j = z; /* convert to integer for tests on the phase angle */ /* map zeros to origin */ if( j & 1 ) { j += 1; y += 1.0; } j = j & 07; /* octant modulo 360 degrees */ /* reflect in x axis */ if( j > 3) { sign = -sign; j -= 4; } z = x - y * 45.0; /* x mod 45 degrees */ z *= PI180; /* multiply by pi/180 to convert to radians */ zz = z * z; if( (j==1) || (j==2) ) { y = 1.0 - zz * polevl( zz, coscof, 6 ); } else { y = z + z * (zz * polevl( zz, sincof, 5 )); } if(sign < 0) y = -y; return(y); } double cosdg(x) double x; { double y, z, zz; int j, sign; /* make argument positive */ sign = 1; if( x < 0 ) x = -x; if( x > lossth ) { mtherr( "cosdg", TLOSS ); return(0.0); } y = md_floor( x/45.0 ); z = md_ldexp( y, -4 ); z = md_floor(z); /* integer part of y/8 */ z = y - md_ldexp( z, 4 ); /* y - 16 * (y/16) */ /* integer and fractional part modulo one octant */ j = z; if( j & 1 ) /* map zeros to origin */ { j += 1; y += 1.0; } j = j & 07; if( j > 3) { j -=4; sign = -sign; } if( j > 1 ) sign = -sign; z = x - y * 45.0; /* x mod 45 degrees */ z *= PI180; /* multiply by pi/180 to convert to radians */ zz = z * z; if( (j==1) || (j==2) ) { y = z + z * (zz * polevl( zz, sincof, 5 )); } else { y = 1.0 - zz * polevl( zz, coscof, 6 ); } if(sign < 0) y = -y; return(y); } Math-Cephes-0.5306/libmd/sqrt.870000644000175000017500000000105114757021403016031 0ustar shlomifshlomif; Static Name Aliases ; TITLE sqrt.c .8087 INCLUDELIB SLIBCE _TEXT SEGMENT WORD PUBLIC 'CODE' _TEXT ENDS _DATA SEGMENT WORD PUBLIC 'DATA' _DATA ENDS CONST SEGMENT WORD PUBLIC 'CONST' CONST ENDS _BSS SEGMENT WORD PUBLIC 'BSS' _BSS ENDS DGROUP GROUP CONST, _BSS, _DATA ASSUME DS: DGROUP, SS: DGROUP EXTRN __fac:QWORD EXTRN __fltused:NEAR _TEXT SEGMENT ASSUME CS: _TEXT PUBLIC _sqrt _sqrt PROC NEAR push bp mov bp,sp fld QWORD PTR [bp+4] fsqrt fwait fstp QWORD PTR __fac mov ax,OFFSET __fac pop bp ret _sqrt ENDP _TEXT ENDS END Math-Cephes-0.5306/libmd/mtherr.c0000644000175000017500000000450114757021403016330 0ustar shlomifshlomif/* mtherr.c * * Library common error handling routine * * * * SYNOPSIS: * * char *fctnam; * int code; * int mtherr(); * * mtherr( fctnam, code ); * * * * DESCRIPTION: * * This routine may be called to report one of the following * error conditions (in the include file mconf.h). * * Mnemonic Value Significance * * DOMAIN 1 argument domain error * SING 2 function singularity * OVERFLOW 3 overflow range error * UNDERFLOW 4 underflow range error * TLOSS 5 total loss of precision * PLOSS 6 partial loss of precision * EDOM 33 Unix domain error code * ERANGE 34 Unix range error code * * The default version of the file prints the function name, * passed to it by the pointer fctnam, followed by the * error condition. The display is directed to the standard * output device. The routine then returns to the calling * program. Users may wish to modify the program to abort by * calling exit() under severe error conditions such as domain * errors. * * Since all error conditions pass control to this function, * the display may be easily changed, eliminated, or directed * to an error logging device. * * SEE ALSO: * * mconf.h * */ /* Cephes Math Library Release 2.0: April, 1987 Copyright 1984, 1987 by Stephen L. Moshier Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */ #include #include "mconf.h" int merror = 0; /* Notice: the order of appearance of the following * messages is bound to the error codes defined * in mconf.h. */ static char *ermsg[7] = { "unknown", /* error code 0 */ "domain", /* error code 1 */ "singularity", /* et seq. */ "overflow", "underflow", "total loss of precision", "partial loss of precision" }; int mtherr( name, code ) char *name; int code; { /* Display string passed by calling program, * which is supposed to be the name of the * function in which the error occurred: */ printf( "\n%s ", name ); /* Set global error message word */ merror = code; /* Display error message defined * by the code argument. */ if( (code <= 0) || (code >= 7) ) code = 0; printf( "%s error\n", ermsg[code] ); /* Return to calling * program */ return( 0 ); } Math-Cephes-0.5306/libmd/stdtr.c0000644000175000017500000001005314757021403016166 0ustar shlomifshlomif/* stdtr.c * * Student's t distribution * * * * SYNOPSIS: * * double t, stdtr(); * short k; * * y = stdtr( k, t ); * * * DESCRIPTION: * * Computes the integral from minus infinity to t of the Student * t distribution with integer k > 0 degrees of freedom: * * t * - * | | * - | 2 -(k+1)/2 * | ( (k+1)/2 ) | ( x ) * ---------------------- | ( 1 + --- ) dx * - | ( k ) * sqrt( k pi ) | ( k/2 ) | * | | * - * -inf. * * Relation to incomplete beta integral: * * 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) * where * z = k/(k + t**2). * * For t < -2, this is the method of computation. For higher t, * a direct method is derived from integration by parts. * Since the function is symmetric about t=0, the area under the * right tail of the density is found by calling the function * with -t instead of t. * * ACCURACY: * * Tested at random 1 <= k <= 25. The "domain" refers to t. * Relative error: * arithmetic domain # trials peak rms * IEEE -100,-2 50000 5.9e-15 1.4e-15 * IEEE -2,100 500000 2.7e-15 4.9e-17 */ /* stdtri.c * * Functional inverse of Student's t distribution * * * * SYNOPSIS: * * double p, t, stdtri(); * int k; * * t = stdtri( k, p ); * * * DESCRIPTION: * * Given probability p, finds the argument t such that stdtr(k,t) * is equal to p. * * ACCURACY: * * Tested at random 1 <= k <= 100. The "domain" refers to p: * Relative error: * arithmetic domain # trials peak rms * IEEE .001,.999 25000 5.7e-15 8.0e-16 * IEEE 10^-6,.001 25000 2.0e-12 2.9e-14 */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" extern double PI, MACHEP, MAXNUM; #ifdef ANSIPROT extern double sqrt ( double ); extern double md_atan ( double ); extern double incbet ( double, double, double ); extern double incbi ( double, double, double ); extern double md_fabs ( double ); #else double sqrt(), md_atan(), incbet(), incbi(), md_fabs(); #endif double stdtr( k, t ) int k; double t; { double x, rk, z, f, tz, p, xsqk; int j; if( k <= 0 ) { mtherr( "stdtr", DOMAIN ); return(0.0); } if( t == 0 ) return( 0.5 ); if( t < -2.0 ) { rk = k; z = rk / (rk + t * t); p = 0.5 * incbet( 0.5*rk, 0.5, z ); return( p ); } /* compute integral from -t to + t */ if( t < 0 ) x = -t; else x = t; rk = k; /* degrees of freedom */ z = 1.0 + ( x * x )/rk; /* test if k is odd or even */ if( (k & 1) != 0) { /* computation for odd k */ xsqk = x/sqrt(rk); p = md_atan( xsqk ); if( k > 1 ) { f = 1.0; tz = 1.0; j = 3; while( (j<=(k-2)) && ( (tz/f) > MACHEP ) ) { tz *= (j-1)/( z * j ); f += tz; j += 2; } p += f * xsqk/z; } p *= 2.0/PI; } else { /* computation for even k */ f = 1.0; tz = 1.0; j = 2; while( ( j <= (k-2) ) && ( (tz/f) > MACHEP ) ) { tz *= (j - 1)/( z * j ); f += tz; j += 2; } p = f * x/sqrt(z*rk); } /* common exit */ if( t < 0 ) p = -p; /* note destruction of relative accuracy */ p = 0.5 + 0.5 * p; return(p); } double stdtri( k, p ) int k; double p; { double t, rk, z; int rflg; if( k <= 0 || p <= 0.0 || p >= 1.0 ) { mtherr( "stdtri", DOMAIN ); return(0.0); } rk = k; if( p > 0.25 && p < 0.75 ) { if( p == 0.5 ) return( 0.0 ); z = 1.0 - 2.0 * p; z = incbi( 0.5, 0.5*rk, md_fabs(z) ); t = sqrt( rk*z/(1.0-z) ); if( p < 0.5 ) t = -t; return( t ); } rflg = -1; if( p >= 0.5) { p = 1.0 - p; rflg = 1; } z = incbi( 0.5*rk, 0.5, 2.0*p ); if( MAXNUM * z < rk ) return(rflg* MAXNUM); t = sqrt( rk/z - rk ); return( rflg * t ); } Math-Cephes-0.5306/libmd/sqrt.6880000644000175000017500000000013014757021403016115 0ustar shlomifshlomif .even .globl _sqrt _sqrt: link a6,#0 fmoved a6@(8),fp0 fsqrtx fp0,fp0 unlk a6 rts Math-Cephes-0.5306/libmd/atanh.c0000644000175000017500000000602414757021403016124 0ustar shlomifshlomif/* md_atanh.c * * Inverse hyperbolic tangent * * * * SYNOPSIS: * * double x, y, md_atanh(); * * y = md_atanh( x ); * * * * DESCRIPTION: * * Returns inverse hyperbolic tangent of argument in the range * MINLOG to MAXLOG. * * If |x| < 0.5, the rational form x + x**3 P(x)/Q(x) is * employed. Otherwise, * md_atanh(x) = 0.5 * md_log( (1+x)/(1-x) ). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -1,1 50000 2.4e-17 6.4e-18 * IEEE -1,1 30000 1.9e-16 5.2e-17 * */ /* md_atanh.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright (C) 1987, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double P[] = { -8.54074331929669305196E-1, 1.20426861384072379242E1, -4.61252884198732692637E1, 6.54566728676544377376E1, -3.09092539379866942570E1 }; static double Q[] = { /* 1.00000000000000000000E0,*/ -1.95638849376911654834E1, 1.08938092147140262656E2, -2.49839401325893582852E2, 2.52006675691344555838E2, -9.27277618139601130017E1 }; #endif #ifdef DEC static unsigned short P[] = { 0140132,0122235,0105775,0130300, 0041100,0127327,0124407,0034722, 0141470,0100113,0115607,0130535, 0041602,0164721,0003257,0013673, 0141367,0043046,0166673,0045750 }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0141234,0101326,0015460,0134564, 0041731,0160115,0116451,0032045, 0142171,0153343,0000532,0167226, 0042174,0000665,0077604,0000310, 0141671,0072235,0031114,0074377 }; #endif #ifdef IBMPC static unsigned short P[] = { 0xb618,0xb17f,0x5493,0xbfeb, 0xe73a,0xf520,0x15da,0x4028, 0xf62c,0x7370,0x1009,0xc047, 0xe2f7,0x20d5,0x5d3a,0x4050, 0x697d,0xddb7,0xe8c4,0xc03e }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x172f,0xc366,0x905a,0xc033, 0x2685,0xb3a5,0x3c09,0x405b, 0x5dd3,0x602b,0x3adc,0xc06f, 0x8019,0xaff0,0x8036,0x406f, 0x8f20,0xa649,0x2e93,0xc057 }; #endif #ifdef MIEEE static unsigned short P[] = { 0xbfeb,0x5493,0xb17f,0xb618, 0x4028,0x15da,0xf520,0xe73a, 0xc047,0x1009,0x7370,0xf62c, 0x4050,0x5d3a,0x20d5,0xe2f7, 0xc03e,0xe8c4,0xddb7,0x697d }; static unsigned short Q[] = { 0xc033,0x905a,0xc366,0x172f, 0x405b,0x3c09,0xb3a5,0x2685, 0xc06f,0x3adc,0x602b,0x5dd3, 0x406f,0x8036,0xaff0,0x8019, 0xc057,0x2e93,0xa649,0x8f20 }; #endif #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_log ( double x ); extern double polevl ( double x, void *P, int N ); extern double p1evl ( double x, void *P, int N ); #else double md_fabs(), md_log(), polevl(), p1evl(); #endif extern double INFINITY, NAN; double md_atanh(x) double x; { double s, z; #ifdef MINUSZERO if( x == 0.0 ) return(x); #endif z = md_fabs(x); if( z >= 1.0 ) { if( x == 1.0 ) return( INFINITY ); if( x == -1.0 ) return( -INFINITY ); mtherr( "md_atanh", DOMAIN ); return( NAN ); } if( z < 1.0e-7 ) return(x); if( z < 0.5 ) { z = x * x; s = x + x * z * (polevl(z, P, 4) / p1evl(z, Q, 5)); return(s); } return( 0.5 * md_log((1.0+x)/(1.0-x)) ); } Math-Cephes-0.5306/libmd/polrt_wrap.c0000644000175000017500000000156114757021403017223 0ustar shlomifshlomif/* polrt.c * * Wrapper to polrt.c * * * * SYNOPSIS: * * typedef struct * { * double r; * double i; * }cmplx; * * double xcof[], cof[], r[], i[]; * int m; * * polrt_wrap( xcof, cof, m, r, i ) * * * */ #include "mconf.h" #include #ifdef ANSIPROT extern void * malloc ( long ); extern void free ( void * ); #else void * malloc(); void free (); #endif /* typedef struct { double r; double i; }cmplx; */ int polrt_wrap( xcof, cof, m, r, i ) double xcof[], cof[], r[], i[]; int m; { extern int polrt( double xcof[], double cof[], int m, cmplx root[] ); cmplx *root; int j, ret; root = (cmplx *) malloc( (m+1) * sizeof (cmplx) ); for (j=0; j<=m; j++) { root[j].r = 0; root[j].i = 0; } ret = polrt( xcof, cof, m, root ); for (j=0; j<=m; j++) { r[j] = root[j].r; i[j] = root[j].i; } free(root); return ret; } Math-Cephes-0.5306/libmd/sqrt.3870000644000175000017500000000016714757021403016123 0ustar shlomifshlomif .file "sqrt.i" gcc2_compiled.: .text .globl _sqrt _sqrt: pushl %ebp movl %esp,%ebp fldl 8(%ebp) fsqrt leave ret Math-Cephes-0.5306/libmd/sin.c0000644000175000017500000001770614757021403015633 0ustar shlomifshlomif/* md_sin.c * * Circular sine * * * * SYNOPSIS: * * double x, y, md_sin(); * * y = md_sin( x ); * * * * DESCRIPTION: * * Range reduction is into intervals of pi/4. The reduction * error is nearly eliminated by contriving an extended precision * modular arithmetic. * * Two polynomial approximating functions are employed. * Between 0 and pi/4 the sine is approximated by * x + x**3 P(x**2). * Between pi/4 and pi/2 the cosine is represented as * 1 - x**2 Q(x**2). * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 0, 10 150000 3.0e-17 7.8e-18 * IEEE -1.07e9,+1.07e9 130000 2.1e-16 5.4e-17 * * ERROR MESSAGES: * * message condition value returned * md_sin total loss x > 1.073741824e9 0.0 * * Partial loss of accuracy begins to occur at x = 2**30 * = 1.074e9. The loss is not gradual, but jumps suddenly to * about 1 part in 10e7. Results may be meaningless for * x > 2**49 = 5.6e14. The routine as implemented flags a * TLOSS error for x > 2**30 and returns 0.0. */ /* md_cos.c * * Circular cosine * * * * SYNOPSIS: * * double x, y, md_cos(); * * y = md_cos( x ); * * * * DESCRIPTION: * * Range reduction is into intervals of pi/4. The reduction * error is nearly eliminated by contriving an extended precision * modular arithmetic. * * Two polynomial approximating functions are employed. * Between 0 and pi/4 the cosine is approximated by * 1 - x**2 Q(x**2). * Between pi/4 and pi/2 the sine is represented as * x + x**3 P(x**2). * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -1.07e9,+1.07e9 130000 2.1e-16 5.4e-17 * DEC 0,+1.07e9 17000 3.0e-17 7.2e-18 */ /* md_sin.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1985, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double sincof[] = { 1.58962301576546568060E-10, -2.50507477628578072866E-8, 2.75573136213857245213E-6, -1.98412698295895385996E-4, 8.33333333332211858878E-3, -1.66666666666666307295E-1, }; static double coscof[6] = { -1.13585365213876817300E-11, 2.08757008419747316778E-9, -2.75573141792967388112E-7, 2.48015872888517045348E-5, -1.38888888888730564116E-3, 4.16666666666665929218E-2, }; static double DP1 = 7.85398125648498535156E-1; static double DP2 = 3.77489470793079817668E-8; static double DP3 = 2.69515142907905952645E-15; /* static double lossth = 1.073741824e9; */ #endif #ifdef DEC static unsigned short sincof[] = { 0030056,0143750,0177214,0163153, 0131727,0027455,0044510,0175352, 0033470,0167432,0131752,0042414, 0135120,0006400,0146776,0174027, 0036410,0104210,0104207,0137202, 0137452,0125252,0125252,0125103, }; static unsigned short coscof[24] = { 0127107,0151115,0002060,0152325, 0031017,0072353,0155161,0174053, 0132623,0171173,0172542,0057056, 0034320,0006400,0147102,0023652, 0135666,0005540,0133012,0076213, 0037052,0125252,0125252,0125126, }; /* 7.853981629014015197753906250000E-1 */ static unsigned short P1[] = {0040111,0007732,0120000,0000000,}; /* 4.960467869796758577649598009884E-10 */ static unsigned short P2[] = {0030410,0055060,0100000,0000000,}; /* 2.860594363054915898381331279295E-18 */ static unsigned short P3[] = {0021523,0011431,0105056,0001560,}; #define DP1 *(double *)P1 #define DP2 *(double *)P2 #define DP3 *(double *)P3 #endif #ifdef IBMPC static unsigned short sincof[] = { 0x9ccd,0x1fd1,0xd8fd,0x3de5, 0x1f5d,0xa929,0xe5e5,0xbe5a, 0x48a1,0x567d,0x1de3,0x3ec7, 0xdf03,0x19bf,0x01a0,0xbf2a, 0xf7d0,0x1110,0x1111,0x3f81, 0x5548,0x5555,0x5555,0xbfc5, }; static unsigned short coscof[24] = { 0x1a9b,0xa086,0xfa49,0xbda8, 0x3f05,0x7b4e,0xee9d,0x3e21, 0x4bc6,0x7eac,0x7e4f,0xbe92, 0x44f5,0x19c8,0x01a0,0x3efa, 0x4f91,0x16c1,0xc16c,0xbf56, 0x554b,0x5555,0x5555,0x3fa5, }; /* 7.85398125648498535156E-1, 3.77489470793079817668E-8, 2.69515142907905952645E-15, */ static unsigned short P1[] = {0x0000,0x4000,0x21fb,0x3fe9}; static unsigned short P2[] = {0x0000,0x0000,0x442d,0x3e64}; static unsigned short P3[] = {0x5170,0x98cc,0x4698,0x3ce8}; #define DP1 *(double *)P1 #define DP2 *(double *)P2 #define DP3 *(double *)P3 #endif #ifdef MIEEE static unsigned short sincof[] = { 0x3de5,0xd8fd,0x1fd1,0x9ccd, 0xbe5a,0xe5e5,0xa929,0x1f5d, 0x3ec7,0x1de3,0x567d,0x48a1, 0xbf2a,0x01a0,0x19bf,0xdf03, 0x3f81,0x1111,0x1110,0xf7d0, 0xbfc5,0x5555,0x5555,0x5548, }; static unsigned short coscof[24] = { 0xbda8,0xfa49,0xa086,0x1a9b, 0x3e21,0xee9d,0x7b4e,0x3f05, 0xbe92,0x7e4f,0x7eac,0x4bc6, 0x3efa,0x01a0,0x19c8,0x44f5, 0xbf56,0xc16c,0x16c1,0x4f91, 0x3fa5,0x5555,0x5555,0x554b, }; static unsigned short P1[] = {0x3fe9,0x21fb,0x4000,0x0000}; static unsigned short P2[] = {0x3e64,0x442d,0x0000,0x0000}; static unsigned short P3[] = {0x3ce8,0x4698,0x98cc,0x5170}; #define DP1 *(double *)P1 #define DP2 *(double *)P2 #define DP3 *(double *)P3 #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_floor ( double ); extern double md_ldexp ( double, int ); extern int isnan ( double ); extern int isfinite ( double ); #else double polevl(), md_floor(), md_ldexp(); int isnan(), isfinite(); #endif extern double PIO4; static double lossth = 1.073741824e9; #ifdef NANS extern double NAN; #endif #ifdef INFINITIES extern double INFINITY; #endif double md_sin(x) double x; { double y, z, zz; int j, sign; #ifdef MINUSZERO if( x == 0.0 ) return(x); #endif #ifdef NANS if( isnan(x) ) return(x); if( !isfinite(x) ) { mtherr( "md_sin", DOMAIN ); return(NAN); } #endif /* make argument positive but save the sign */ sign = 1; if( x < 0 ) { x = -x; sign = -1; } if( x > lossth ) { mtherr( "md_sin", TLOSS ); return(0.0); } y = md_floor( x/PIO4 ); /* integer part of x/PIO4 */ /* strip high bits of integer part to prevent integer overflow */ z = md_ldexp( y, -4 ); z = md_floor(z); /* integer part of y/8 */ z = y - md_ldexp( z, 4 ); /* y - 16 * (y/16) */ j = z; /* convert to integer for tests on the phase angle */ /* map zeros to origin */ if( j & 1 ) { j += 1; y += 1.0; } j = j & 07; /* octant modulo 360 degrees */ /* reflect in x axis */ if( j > 3) { sign = -sign; j -= 4; } /* Extended precision modular arithmetic */ z = ((x - y * DP1) - y * DP2) - y * DP3; zz = z * z; if( (j==1) || (j==2) ) { y = 1.0 - md_ldexp(zz,-1) + zz * zz * polevl( zz, coscof, 5 ); } else { /* y = z + z * (zz * polevl( zz, sincof, 5 ));*/ y = z + z * z * z * polevl( zz, sincof, 5 ); } if(sign < 0) y = -y; return(y); } double md_cos(x) double x; { double y, z, zz; long i; int j, sign; #ifdef NANS if( isnan(x) ) return(x); if( !isfinite(x) ) { mtherr( "md_cos", DOMAIN ); return(NAN); } #endif /* make argument positive */ sign = 1; if( x < 0 ) x = -x; if( x > lossth ) { mtherr( "md_cos", TLOSS ); return(0.0); } y = md_floor( x/PIO4 ); z = md_ldexp( y, -4 ); z = md_floor(z); /* integer part of y/8 */ z = y - md_ldexp( z, 4 ); /* y - 16 * (y/16) */ /* integer and fractional part modulo one octant */ i = z; if( i & 1 ) /* map zeros to origin */ { i += 1; y += 1.0; } j = i & 07; if( j > 3) { j -=4; sign = -sign; } if( j > 1 ) sign = -sign; /* Extended precision modular arithmetic */ z = ((x - y * DP1) - y * DP2) - y * DP3; zz = z * z; if( (j==1) || (j==2) ) { /* y = z + z * (zz * polevl( zz, sincof, 5 ));*/ y = z + z * z * z * polevl( zz, sincof, 5 ); } else { y = 1.0 - md_ldexp(zz,-1) + zz * zz * polevl( zz, coscof, 5 ); } if(sign < 0) y = -y; return(y); } /* Degrees, minutes, seconds to radians: */ /* 1 arc second, in radians = 4.8481368110953599358991410e-6 */ #ifdef DEC static unsigned short P648[] = {034513,054170,0176773,0116043,}; #define P64800 *(double *)P648 #else static double P64800 = 4.8481368110953599358991410e-6; #endif double radian(d,m,s) double d,m,s; { return( ((d*60.0 + m)*60.0 + s)*P64800 ); } Math-Cephes-0.5306/libmd/i1.c0000644000175000017500000002205714757021403015346 0ustar shlomifshlomif/* i1.c * * Modified Bessel function of order one * * * * SYNOPSIS: * * double x, y, i1(); * * y = i1( x ); * * * * DESCRIPTION: * * Returns modified Bessel function of order one of the * argument. * * The function is defined as i1(x) = -i md_j1( ix ). * * The range is partitioned into the two intervals [0,8] and * (8, infinity). Chebyshev polynomial expansions are employed * in each interval. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 0, 30 3400 1.2e-16 2.3e-17 * IEEE 0, 30 30000 1.9e-15 2.1e-16 * * */ /* i1e.c * * Modified Bessel function of order one, * exponentially scaled * * * * SYNOPSIS: * * double x, y, i1e(); * * y = i1e( x ); * * * * DESCRIPTION: * * Returns exponentially scaled modified Bessel function * of order one of the argument. * * The function is defined as i1(x) = -i md_exp(-|x|) md_j1( ix ). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0, 30 30000 2.0e-15 2.0e-16 * See i1(). * */ /* i1.c 2 */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1985, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" /* Chebyshev coefficients for md_exp(-x) I1(x) / x * in the interval [0,8]. * * lim(x->0){ md_exp(-x) I1(x) / x } = 1/2. */ #ifdef UNK static double A[] = { 2.77791411276104639959E-18, -2.11142121435816608115E-17, 1.55363195773620046921E-16, -1.10559694773538630805E-15, 7.60068429473540693410E-15, -5.04218550472791168711E-14, 3.22379336594557470981E-13, -1.98397439776494371520E-12, 1.17361862988909016308E-11, -6.66348972350202774223E-11, 3.62559028155211703701E-10, -1.88724975172282928790E-9, 9.38153738649577178388E-9, -4.44505912879632808065E-8, 2.00329475355213526229E-7, -8.56872026469545474066E-7, 3.47025130813767847674E-6, -1.32731636560394358279E-5, 4.78156510755005422638E-5, -1.61760815825896745588E-4, 5.12285956168575772895E-4, -1.51357245063125314899E-3, 4.15642294431288815669E-3, -1.05640848946261981558E-2, 2.47264490306265168283E-2, -5.29459812080949914269E-2, 1.02643658689847095384E-1, -1.76416518357834055153E-1, 2.52587186443633654823E-1 }; #endif #ifdef DEC static unsigned short A[] = { 0021514,0174520,0060742,0000241, 0122302,0137206,0016120,0025663, 0023063,0017437,0026235,0176536, 0123637,0052523,0170150,0125632, 0024410,0165770,0030251,0044134, 0125143,0012160,0162170,0054727, 0025665,0075702,0035716,0145247, 0126413,0116032,0176670,0015462, 0027116,0073425,0110351,0105242, 0127622,0104034,0137530,0037364, 0030307,0050645,0120776,0175535, 0131001,0130331,0043523,0037455, 0031441,0026160,0010712,0100174, 0132076,0164761,0022706,0017500, 0032527,0015045,0115076,0104076, 0133146,0001714,0015434,0144520, 0033550,0161166,0124215,0077050, 0134136,0127715,0143365,0157170, 0034510,0106652,0013070,0064130, 0135051,0117126,0117264,0123761, 0035406,0045355,0133066,0175751, 0135706,0061420,0054746,0122440, 0036210,0031232,0047235,0006640, 0136455,0012373,0144235,0011523, 0036712,0107437,0036731,0015111, 0137130,0156742,0115744,0172743, 0037322,0033326,0124667,0124740, 0137464,0123210,0021510,0144556, 0037601,0051433,0111123,0177721 }; #endif #ifdef IBMPC static unsigned short A[] = { 0x4014,0x0c3c,0x9f2a,0x3c49, 0x0576,0xc38a,0x57d0,0xbc78, 0xbfac,0xe593,0x63e3,0x3ca6, 0x1573,0x7e0d,0xeaaa,0xbcd3, 0x290c,0x0615,0x1d7f,0x3d01, 0x0b3b,0x1c8f,0x628e,0xbd2c, 0xd955,0x4779,0xaf78,0x3d56, 0x0366,0x5fb7,0x7383,0xbd81, 0x3154,0xb21d,0xcee2,0x3da9, 0x07de,0x97eb,0x5103,0xbdd2, 0xdf6c,0xb43f,0xea34,0x3df8, 0x67e6,0x28ea,0x361b,0xbe20, 0x5010,0x0239,0x258e,0x3e44, 0xc3e8,0x24b8,0xdd3e,0xbe67, 0xd108,0xb347,0xe344,0x3e8a, 0x992a,0x8363,0xc079,0xbeac, 0xafc5,0xd511,0x1c4e,0x3ecd, 0xbbcf,0xb8de,0xd5f9,0xbeeb, 0x0d0b,0x42c7,0x11b5,0x3f09, 0x94fe,0xd3d6,0x33ca,0xbf25, 0xdf7d,0xb6c6,0xc95d,0x3f40, 0xd4a4,0x0b3c,0xcc62,0xbf58, 0xa1b4,0x49d3,0x0653,0x3f71, 0xa26a,0x7913,0xa29f,0xbf85, 0x2349,0xe7bb,0x51e3,0x3f99, 0x9ebc,0x537c,0x1bbc,0xbfab, 0xf53c,0xd536,0x46da,0x3fba, 0x192e,0x0469,0x94d1,0xbfc6, 0x7ffa,0x724a,0x2a63,0x3fd0 }; #endif #ifdef MIEEE static unsigned short A[] = { 0x3c49,0x9f2a,0x0c3c,0x4014, 0xbc78,0x57d0,0xc38a,0x0576, 0x3ca6,0x63e3,0xe593,0xbfac, 0xbcd3,0xeaaa,0x7e0d,0x1573, 0x3d01,0x1d7f,0x0615,0x290c, 0xbd2c,0x628e,0x1c8f,0x0b3b, 0x3d56,0xaf78,0x4779,0xd955, 0xbd81,0x7383,0x5fb7,0x0366, 0x3da9,0xcee2,0xb21d,0x3154, 0xbdd2,0x5103,0x97eb,0x07de, 0x3df8,0xea34,0xb43f,0xdf6c, 0xbe20,0x361b,0x28ea,0x67e6, 0x3e44,0x258e,0x0239,0x5010, 0xbe67,0xdd3e,0x24b8,0xc3e8, 0x3e8a,0xe344,0xb347,0xd108, 0xbeac,0xc079,0x8363,0x992a, 0x3ecd,0x1c4e,0xd511,0xafc5, 0xbeeb,0xd5f9,0xb8de,0xbbcf, 0x3f09,0x11b5,0x42c7,0x0d0b, 0xbf25,0x33ca,0xd3d6,0x94fe, 0x3f40,0xc95d,0xb6c6,0xdf7d, 0xbf58,0xcc62,0x0b3c,0xd4a4, 0x3f71,0x0653,0x49d3,0xa1b4, 0xbf85,0xa29f,0x7913,0xa26a, 0x3f99,0x51e3,0xe7bb,0x2349, 0xbfab,0x1bbc,0x537c,0x9ebc, 0x3fba,0x46da,0xd536,0xf53c, 0xbfc6,0x94d1,0x0469,0x192e, 0x3fd0,0x2a63,0x724a,0x7ffa }; #endif /* i1.c */ /* Chebyshev coefficients for md_exp(-x) sqrt(x) I1(x) * in the inverted interval [8,infinity]. * * lim(x->inf){ md_exp(-x) sqrt(x) I1(x) } = 1/sqrt(2pi). */ #ifdef UNK static double B[] = { 7.51729631084210481353E-18, 4.41434832307170791151E-18, -4.65030536848935832153E-17, -3.20952592199342395980E-17, 2.96262899764595013876E-16, 3.30820231092092828324E-16, -1.88035477551078244854E-15, -3.81440307243700780478E-15, 1.04202769841288027642E-14, 4.27244001671195135429E-14, -2.10154184277266431302E-14, -4.08355111109219731823E-13, -7.19855177624590851209E-13, 2.03562854414708950722E-12, 1.41258074366137813316E-11, 3.25260358301548823856E-11, -1.89749581235054123450E-11, -5.58974346219658380687E-10, -3.83538038596423702205E-9, -2.63146884688951950684E-8, -2.51223623787020892529E-7, -3.88256480887769039346E-6, -1.10588938762623716291E-4, -9.76109749136146840777E-3, 7.78576235018280120474E-1 }; #endif #ifdef DEC static unsigned short B[] = { 0022012,0125555,0115227,0043456, 0021642,0156127,0052075,0145203, 0122526,0072435,0111231,0011664, 0122424,0001544,0161671,0114403, 0023252,0144257,0163532,0142121, 0023276,0132162,0174045,0013204, 0124007,0077154,0057046,0110517, 0124211,0066650,0116127,0157073, 0024473,0133413,0130551,0107504, 0025100,0064741,0032631,0040364, 0124675,0045101,0071551,0012400, 0125745,0161054,0071637,0011247, 0126112,0117410,0035525,0122231, 0026417,0037237,0131034,0176427, 0027170,0100373,0024742,0025725, 0027417,0006417,0105303,0141446, 0127246,0163716,0121202,0060137, 0130431,0123122,0120436,0166000, 0131203,0144134,0153251,0124500, 0131742,0005234,0122732,0033006, 0132606,0157751,0072362,0121031, 0133602,0043372,0047120,0015626, 0134747,0165774,0001125,0046462, 0136437,0166402,0117746,0155137, 0040107,0050305,0125330,0124241 }; #endif #ifdef IBMPC static unsigned short B[] = { 0xe8e6,0xb352,0x556d,0x3c61, 0xb950,0xea87,0x5b8a,0x3c54, 0x2277,0xb253,0xcea3,0xbc8a, 0x3320,0x9c77,0x806c,0xbc82, 0x588a,0xfceb,0x5915,0x3cb5, 0xa2d1,0x5f04,0xd68e,0x3cb7, 0xd22a,0x8bc4,0xefcd,0xbce0, 0xfbc7,0x138a,0x2db5,0xbcf1, 0x31e8,0x762d,0x76e1,0x3d07, 0x281e,0x26b3,0x0d3c,0x3d28, 0x22a0,0x2e6d,0xa948,0xbd17, 0xe255,0x8e73,0xbc45,0xbd5c, 0xb493,0x076a,0x53e1,0xbd69, 0x9fa3,0xf643,0xe7d3,0x3d81, 0x457b,0x653c,0x101f,0x3daf, 0x7865,0xf158,0xe1a1,0x3dc1, 0x4c0c,0xd450,0xdcf9,0xbdb4, 0xdd80,0x5423,0x34ca,0xbe03, 0x3528,0x9ad5,0x790b,0xbe30, 0x46c1,0x94bb,0x4153,0xbe5c, 0x5443,0x2e9e,0xdbfd,0xbe90, 0x0373,0x49ca,0x48df,0xbed0, 0xa9a6,0x804a,0xfd7f,0xbf1c, 0xdb4c,0x53fc,0xfda0,0xbf83, 0x1514,0xb55b,0xea18,0x3fe8 }; #endif #ifdef MIEEE static unsigned short B[] = { 0x3c61,0x556d,0xb352,0xe8e6, 0x3c54,0x5b8a,0xea87,0xb950, 0xbc8a,0xcea3,0xb253,0x2277, 0xbc82,0x806c,0x9c77,0x3320, 0x3cb5,0x5915,0xfceb,0x588a, 0x3cb7,0xd68e,0x5f04,0xa2d1, 0xbce0,0xefcd,0x8bc4,0xd22a, 0xbcf1,0x2db5,0x138a,0xfbc7, 0x3d07,0x76e1,0x762d,0x31e8, 0x3d28,0x0d3c,0x26b3,0x281e, 0xbd17,0xa948,0x2e6d,0x22a0, 0xbd5c,0xbc45,0x8e73,0xe255, 0xbd69,0x53e1,0x076a,0xb493, 0x3d81,0xe7d3,0xf643,0x9fa3, 0x3daf,0x101f,0x653c,0x457b, 0x3dc1,0xe1a1,0xf158,0x7865, 0xbdb4,0xdcf9,0xd450,0x4c0c, 0xbe03,0x34ca,0x5423,0xdd80, 0xbe30,0x790b,0x9ad5,0x3528, 0xbe5c,0x4153,0x94bb,0x46c1, 0xbe90,0xdbfd,0x2e9e,0x5443, 0xbed0,0x48df,0x49ca,0x0373, 0xbf1c,0xfd7f,0x804a,0xa9a6, 0xbf83,0xfda0,0x53fc,0xdb4c, 0x3fe8,0xea18,0xb55b,0x1514 }; #endif /* i1.c */ #ifdef ANSIPROT extern double chbevl ( double, void *, int ); extern double md_exp ( double ); extern double sqrt ( double ); extern double md_fabs ( double ); #else double chbevl(), md_exp(), sqrt(), md_fabs(); #endif double i1(x) double x; { double y, z; z = md_fabs(x); if( z <= 8.0 ) { y = (z/2.0) - 2.0; z = chbevl( y, A, 29 ) * z * md_exp(z); } else { z = md_exp(z) * chbevl( 32.0/z - 2.0, B, 25 ) / sqrt(z); } if( x < 0.0 ) z = -z; return( z ); } /* i1e() */ double i1e( x ) double x; { double y, z; z = md_fabs(x); if( z <= 8.0 ) { y = (z/2.0) - 2.0; z = chbevl( y, A, 29 ) * z; } else { z = chbevl( 32.0/z - 2.0, B, 25 ) / sqrt(z); } if( x < 0.0 ) z = -z; return( z ); } Math-Cephes-0.5306/libmd/btdtr.c0000644000175000017500000000176014757021403016152 0ustar shlomifshlomif /* btdtr.c * * Beta distribution * * * * SYNOPSIS: * * double a, b, x, y, btdtr(); * * y = btdtr( a, b, x ); * * * * DESCRIPTION: * * Returns the area from zero to x under the beta density * function: * * * x * - - * | (a+b) | | a-1 b-1 * P(x) = ---------- | t (1-t) dt * - - | | * | (a) | (b) - * 0 * * * This function is identical to the incomplete beta * integral function incbet(a, b, x). * * The complemented function is * * 1 - P(1-x) = incbet( b, a, x ); * * * ACCURACY: * * See incbet.c. * */ /* btdtr() */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double incbet ( double, double, double ); #else double incbet(); #endif double btdtr( a, b, x ) double a, b, x; { return( incbet( a, b, x ) ); } Math-Cephes-0.5306/libmd/acosh.c0000644000175000017500000000622614757021403016132 0ustar shlomifshlomif/* md_acosh.c * * Inverse hyperbolic cosine * * * * SYNOPSIS: * * double x, y, md_acosh(); * * y = md_acosh( x ); * * * * DESCRIPTION: * * Returns inverse hyperbolic cosine of argument. * * If 1 <= x < 1.5, a rational approximation * * sqrt(z) * P(z)/Q(z) * * where z = x-1, is used. Otherwise, * * md_acosh(x) = md_log( x + sqrt( (x-1)(x+1) ). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 1,3 30000 4.2e-17 1.1e-17 * IEEE 1,3 30000 4.6e-16 8.7e-17 * * * ERROR MESSAGES: * * message condition value returned * md_acosh domain |x| < 1 NAN * */ /* md_acosh.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ /* md_acosh(z) = sqrt(x) * R(x), z = x + 1, interval 0 < x < 0.5 */ #include "mconf.h" #ifdef UNK static double P[] = { 1.18801130533544501356E2, 3.94726656571334401102E3, 3.43989375926195455866E4, 1.08102874834699867335E5, 1.10855947270161294369E5 }; static double Q[] = { /* 1.00000000000000000000E0,*/ 1.86145380837903397292E2, 4.15352677227719831579E3, 2.97683430363289370382E4, 8.29725251988426222434E4, 7.83869920495893927727E4 }; #endif #ifdef DEC static unsigned short P[] = { 0041755,0115055,0144002,0146444, 0043166,0132103,0155150,0150302, 0044006,0057360,0003021,0162753, 0044323,0021557,0175225,0056253, 0044330,0101771,0040046,0006636 }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0042072,0022467,0126670,0041232, 0043201,0146066,0152142,0034015, 0043750,0110257,0121165,0026100, 0044242,0007103,0034667,0033173, 0044231,0014576,0175573,0017472 }; #endif #ifdef IBMPC static unsigned short P[] = { 0x59a4,0xb900,0xb345,0x405d, 0x1a18,0x7b4d,0xd688,0x40ae, 0x3cbd,0x00c2,0xcbde,0x40e0, 0xab95,0xff52,0x646d,0x40fa, 0xc1b4,0x2804,0x107f,0x40fb }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x0853,0xf5b7,0x44a6,0x4067, 0x4702,0xda8c,0x3986,0x40b0, 0xa588,0xf44e,0x1215,0x40dd, 0xe6cf,0x6736,0x41c8,0x40f4, 0x63e7,0xdf6f,0x232f,0x40f3 }; #endif #ifdef MIEEE static unsigned short P[] = { 0x405d,0xb345,0xb900,0x59a4, 0x40ae,0xd688,0x7b4d,0x1a18, 0x40e0,0xcbde,0x00c2,0x3cbd, 0x40fa,0x646d,0xff52,0xab95, 0x40fb,0x107f,0x2804,0xc1b4 }; static unsigned short Q[] = { 0x4067,0x44a6,0xf5b7,0x0853, 0x40b0,0x3986,0xda8c,0x4702, 0x40dd,0x1215,0xf44e,0xa588, 0x40f4,0x41c8,0x6736,0xe6cf, 0x40f3,0x232f,0xdf6f,0x63e7, }; #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_log ( double ); extern double sqrt ( double ); #else double md_log(), sqrt(), polevl(), p1evl(); #endif extern double LOGE2, INFINITY, NAN; double md_acosh(x) double x; { double a, z; if( x < 1.0 ) { mtherr( "md_acosh", DOMAIN ); return(NAN); } if( x > 1.0e8 ) { #ifdef INFINITIES if( x == INFINITY ) return( INFINITY ); #endif return( md_log(x) + LOGE2 ); } z = x - 1.0; if( z < 0.5 ) { a = sqrt(z) * (polevl(z, P, 4) / p1evl(z, Q, 5) ); return( a ); } a = sqrt( z*(x+1.0) ); return( md_log(x + a) ); } Math-Cephes-0.5306/libmd/simq.c0000644000175000017500000000565214757021403016010 0ustar shlomifshlomif/* simq.c * * Solution of simultaneous linear equations AX = B * by Gaussian elimination with partial pivoting * * * * SYNOPSIS: * * double A[n*n], B[n], X[n]; * int n, flag; * int IPS[]; * int simq(); * * ercode = simq( A, B, X, n, flag, IPS ); * * * * DESCRIPTION: * * B, X, IPS are vectors of length n. * A is an n x n matrix (i.e., a vector of length n*n), * stored row-wise: that is, A(i,j) = A[ij], * where ij = i*n + j, which is the transpose of the normal * column-wise storage. * * The contents of matrix A are destroyed. * * Set flag=0 to solve. * Set flag=-1 to do a new back substitution for different B vector * using the same A matrix previously reduced when flag=0. * * The routine returns nonzero on error; messages are printed. * * * ACCURACY: * * Depends on the conditioning (range of eigenvalues) of matrix A. * * * REFERENCE: * * Computer Solution of Linear Algebraic Systems, * by George E. Forsythe and Cleve B. Moler; Prentice-Hall, 1967. * */ /* simq 2 */ #include #define md_fabs(x) ((x) < 0 ? -(x) : (x)) int simq( A, B, X, n, flag, IPS ) double A[], B[], X[]; int n, flag; int IPS[]; { int i, j, ij, ip, ipj, ipk, ipn; int idxpiv, iback; int k, kp, kp1, kpk, kpn; int nip, nkp, nm1; double em, q, rownrm, big, size, pivot, sum; nm1 = n-1; if( flag < 0 ) goto solve; /* Initialize IPS and X */ ij=0; for( i=0; i big ) { big = size; idxpiv = i; } } if( big == 0.0 ) { printf( "SIMQ BIG=0" ); return(2); } if( idxpiv != k ) { j = IPS[k]; IPS[k] = IPS[idxpiv]; IPS[idxpiv] = j; } kp = IPS[k]; kpk = n*kp + k; pivot = A[kpk]; kp1 = k+1; for( i=kp1; i 37.519379347 0.0 * */ /* md_erf.c * * Error function * * * * SYNOPSIS: * * double x, y, md_erf(); * * y = md_erf( x ); * * * * DESCRIPTION: * * The integral is * * x * - * 2 | | 2 * md_erf(x) = -------- | md_exp( - t ) dt. * sqrt(pi) | | * - * 0 * * The magnitude of x is limited to 9.231948545 for DEC * arithmetic; 1 or -1 is returned outside this range. * * For 0 <= |x| < 1, md_erf(x) = x * P4(x**2)/Q5(x**2); otherwise * md_erf(x) = 1 - md_erfc(x). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 0,1 14000 4.7e-17 1.5e-17 * IEEE 0,1 30000 3.7e-16 1.0e-16 * */ /* md_erfc.c * * Complementary error function * * * * SYNOPSIS: * * double x, y, md_erfc(); * * y = md_erfc( x ); * * * * DESCRIPTION: * * * 1 - md_erf(x) = * * inf. * - * 2 | | 2 * md_erfc(x) = -------- | md_exp( - t ) dt * sqrt(pi) | | * - * x * * * For small x, md_erfc(x) = 1 - md_erf(x); otherwise rational * approximations are computed. * * A special function expx2.c is used to suppress error amplification * in computing md_exp(-x^2). * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0,26.6417 30000 1.3e-15 2.2e-16 * * * ERROR MESSAGES: * * message condition value returned * md_erfc underflow x > 9.231948545 (DEC) 0.0 * * */ /* Cephes Math Library Release 2.9: November, 2000 Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier */ #include "mconf.h" extern double SQRTH; extern double MAXLOG; /* Define this macro to suppress error propagation in md_exp(x^2) by using the expx2 function. The tradeoff is that doing so generates two calls to the exponential function instead of one. */ #define USE_EXPXSQ 1 #ifdef UNK static double P[] = { 2.46196981473530512524E-10, 5.64189564831068821977E-1, 7.46321056442269912687E0, 4.86371970985681366614E1, 1.96520832956077098242E2, 5.26445194995477358631E2, 9.34528527171957607540E2, 1.02755188689515710272E3, 5.57535335369399327526E2 }; static double Q[] = { /* 1.00000000000000000000E0,*/ 1.32281951154744992508E1, 8.67072140885989742329E1, 3.54937778887819891062E2, 9.75708501743205489753E2, 1.82390916687909736289E3, 2.24633760818710981792E3, 1.65666309194161350182E3, 5.57535340817727675546E2 }; static double R[] = { 5.64189583547755073984E-1, 1.27536670759978104416E0, 5.01905042251180477414E0, 6.16021097993053585195E0, 7.40974269950448939160E0, 2.97886665372100240670E0 }; static double S[] = { /* 1.00000000000000000000E0,*/ 2.26052863220117276590E0, 9.39603524938001434673E0, 1.20489539808096656605E1, 1.70814450747565897222E1, 9.60896809063285878198E0, 3.36907645100081516050E0 }; static double T[] = { 9.60497373987051638749E0, 9.00260197203842689217E1, 2.23200534594684319226E3, 7.00332514112805075473E3, 5.55923013010394962768E4 }; static double U[] = { /* 1.00000000000000000000E0,*/ 3.35617141647503099647E1, 5.21357949780152679795E2, 4.59432382970980127987E3, 2.26290000613890934246E4, 4.92673942608635921086E4 }; #define UTHRESH 37.519379347 #endif #ifdef DEC static unsigned short P[] = { 0030207,0054445,0011173,0021706, 0040020,0067272,0030661,0122075, 0040756,0151236,0173053,0067042, 0041502,0106175,0062555,0151457, 0042104,0102525,0047401,0003667, 0042403,0116176,0011446,0075303, 0042551,0120723,0061641,0123275, 0042600,0070651,0007264,0134516, 0042413,0061102,0167507,0176625 }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0041123,0123257,0165741,0017142, 0041655,0065027,0173413,0115450, 0042261,0074011,0021573,0004150, 0042563,0166530,0013662,0007200, 0042743,0176427,0162443,0105214, 0043014,0062546,0153727,0123772, 0042717,0012470,0006227,0067424, 0042413,0061103,0003042,0013254 }; static unsigned short R[] = { 0040020,0067272,0101024,0155421, 0040243,0037467,0056706,0026462, 0040640,0116017,0120665,0034315, 0040705,0020162,0143350,0060137, 0040755,0016234,0134304,0130157, 0040476,0122700,0051070,0015473 }; static unsigned short S[] = { /*0040200,0000000,0000000,0000000,*/ 0040420,0126200,0044276,0070413, 0041026,0053051,0007302,0063746, 0041100,0144203,0174051,0061151, 0041210,0123314,0126343,0177646, 0041031,0137125,0051431,0033011, 0040527,0117362,0152661,0066201 }; static unsigned short T[] = { 0041031,0126770,0170672,0166101, 0041664,0006522,0072360,0031770, 0043013,0100025,0162641,0126671, 0043332,0155231,0161627,0076200, 0044131,0024115,0021020,0117343 }; static unsigned short U[] = { /*0040200,0000000,0000000,0000000,*/ 0041406,0037461,0177575,0032714, 0042402,0053350,0123061,0153557, 0043217,0111227,0032007,0164217, 0043660,0145000,0004013,0160114, 0044100,0071544,0167107,0125471 }; #define UTHRESH 14.0 #endif #ifdef IBMPC static unsigned short P[] = { 0x6479,0xa24f,0xeb24,0x3df0, 0x3488,0x4636,0x0dd7,0x3fe2, 0x6dc4,0xdec5,0xda53,0x401d, 0xba66,0xacad,0x518f,0x4048, 0x20f7,0xa9e0,0x90aa,0x4068, 0xcf58,0xc264,0x738f,0x4080, 0x34d8,0x6c74,0x343a,0x408d, 0x972a,0x21d6,0x0e35,0x4090, 0xffb3,0x5de8,0x6c48,0x4081 }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x23cc,0xfd7c,0x74d5,0x402a, 0x7365,0xfee1,0xad42,0x4055, 0x610d,0x246f,0x2f01,0x4076, 0x41d0,0x02f6,0x7dab,0x408e, 0x7151,0xfca4,0x7fa2,0x409c, 0xf4ff,0xdafa,0x8cac,0x40a1, 0xede2,0x0192,0xe2a7,0x4099, 0x42d6,0x60c4,0x6c48,0x4081 }; static unsigned short R[] = { 0x9b62,0x5042,0x0dd7,0x3fe2, 0xc5a6,0xebb8,0x67e6,0x3ff4, 0xa71a,0xf436,0x1381,0x4014, 0x0c0c,0x58dd,0xa40e,0x4018, 0x960e,0x9718,0xa393,0x401d, 0x0367,0x0a47,0xd4b8,0x4007 }; static unsigned short S[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xce21,0x0917,0x1590,0x4002, 0x4cfd,0x21d8,0xcac5,0x4022, 0x2c4d,0x7f05,0x1910,0x4028, 0x7ff5,0x959c,0x14d9,0x4031, 0x26c1,0xaa63,0x37ca,0x4023, 0x2d90,0x5ab6,0xf3de,0x400a }; static unsigned short T[] = { 0x5d88,0x1e37,0x35bf,0x4023, 0x067f,0x4e9e,0x81aa,0x4056, 0x35b7,0xbcb4,0x7002,0x40a1, 0xef90,0x3c72,0x5b53,0x40bb, 0x13dc,0xa442,0x2509,0x40eb }; static unsigned short U[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0xa6ba,0x3fef,0xc7e6,0x4040, 0x3aee,0x14c6,0x4add,0x4080, 0xfd12,0xe680,0xf252,0x40b1, 0x7c0a,0x0101,0x1940,0x40d6, 0xf567,0x9dc8,0x0e6c,0x40e8 }; #define UTHRESH 37.519379347 #endif #ifdef MIEEE static unsigned short P[] = { 0x3df0,0xeb24,0xa24f,0x6479, 0x3fe2,0x0dd7,0x4636,0x3488, 0x401d,0xda53,0xdec5,0x6dc4, 0x4048,0x518f,0xacad,0xba66, 0x4068,0x90aa,0xa9e0,0x20f7, 0x4080,0x738f,0xc264,0xcf58, 0x408d,0x343a,0x6c74,0x34d8, 0x4090,0x0e35,0x21d6,0x972a, 0x4081,0x6c48,0x5de8,0xffb3 }; static unsigned short Q[] = { 0x402a,0x74d5,0xfd7c,0x23cc, 0x4055,0xad42,0xfee1,0x7365, 0x4076,0x2f01,0x246f,0x610d, 0x408e,0x7dab,0x02f6,0x41d0, 0x409c,0x7fa2,0xfca4,0x7151, 0x40a1,0x8cac,0xdafa,0xf4ff, 0x4099,0xe2a7,0x0192,0xede2, 0x4081,0x6c48,0x60c4,0x42d6 }; static unsigned short R[] = { 0x3fe2,0x0dd7,0x5042,0x9b62, 0x3ff4,0x67e6,0xebb8,0xc5a6, 0x4014,0x1381,0xf436,0xa71a, 0x4018,0xa40e,0x58dd,0x0c0c, 0x401d,0xa393,0x9718,0x960e, 0x4007,0xd4b8,0x0a47,0x0367 }; static unsigned short S[] = { 0x4002,0x1590,0x0917,0xce21, 0x4022,0xcac5,0x21d8,0x4cfd, 0x4028,0x1910,0x7f05,0x2c4d, 0x4031,0x14d9,0x959c,0x7ff5, 0x4023,0x37ca,0xaa63,0x26c1, 0x400a,0xf3de,0x5ab6,0x2d90 }; static unsigned short T[] = { 0x4023,0x35bf,0x1e37,0x5d88, 0x4056,0x81aa,0x4e9e,0x067f, 0x40a1,0x7002,0xbcb4,0x35b7, 0x40bb,0x5b53,0x3c72,0xef90, 0x40eb,0x2509,0xa442,0x13dc }; static unsigned short U[] = { 0x4040,0xc7e6,0x3fef,0xa6ba, 0x4080,0x4add,0x14c6,0x3aee, 0x40b1,0xf252,0xe680,0xfd12, 0x40d6,0x1940,0x0101,0x7c0a, 0x40e8,0x0e6c,0x9dc8,0xf567 }; #define UTHRESH 37.519379347 #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_exp ( double ); extern double md_log ( double ); extern double md_fabs ( double ); extern double sqrt ( double ); extern double expx2 ( double, int ); double md_erf ( double ); double md_erfc ( double ); static double erfce ( double ); #else double polevl(), p1evl(), md_exp(), md_log(), md_fabs(); double md_erf(), md_erfc(), expx2(), sqrt(); static double erfce(); #endif double ndtr(a) double a; { double x, y, z; x = a * SQRTH; z = md_fabs(x); /* if( z < SQRTH ) */ if( z < 1.0 ) y = 0.5 + 0.5 * md_erf(x); else { #ifdef USE_EXPXSQ /* See below for erfce. */ y = 0.5 * erfce(z); /* Multiply by md_exp(-x^2 / 2) */ z = expx2(a, -1); y = y * sqrt(z); #else y = 0.5 * md_erfc(z); #endif if( x > 0 ) y = 1.0 - y; } return(y); } double md_erfc(a) double a; { double p,q,x,y,z; if( a < 0.0 ) x = -a; else x = a; if( x < 1.0 ) return( 1.0 - md_erf(a) ); z = -a * a; if( z < -MAXLOG ) { under: mtherr( "md_erfc", UNDERFLOW ); if( a < 0 ) return( 2.0 ); else return( 0.0 ); } #ifdef USE_EXPXSQ /* Compute z = md_exp(z). */ z = expx2(a, -1); #else z = md_exp(z); #endif if( x < 8.0 ) { p = polevl( x, P, 8 ); q = p1evl( x, Q, 8 ); } else { p = polevl( x, R, 5 ); q = p1evl( x, S, 6 ); } y = (z * p)/q; if( a < 0 ) y = 2.0 - y; if( y == 0.0 ) goto under; return(y); } /* Exponentially scaled md_erfc function md_exp(x^2) md_erfc(x) valid for x > 1. Use with ndtr and expx2. */ static double erfce(x) double x; { double p,q; if( x < 8.0 ) { p = polevl( x, P, 8 ); q = p1evl( x, Q, 8 ); } else { p = polevl( x, R, 5 ); q = p1evl( x, S, 6 ); } return (p/q); } double md_erf(x) double x; { double y, z; if( md_fabs(x) > 1.0 ) return( 1.0 - md_erfc(x) ); z = x * x; y = x * polevl( z, T, 4 ) / p1evl( z, U, 5 ); return( y ); } Math-Cephes-0.5306/libmd/polyr.c0000644000175000017500000002177114757021403016204 0ustar shlomifshlomif /* Arithmetic operations on polynomials with rational coefficients * * In the following descriptions a, b, c are polynomials of degree * na, nb, nc respectively. The degree of a polynomial cannot * exceed a run-time value FMAXPOL. An operation that attempts * to use or generate a polynomial of higher degree may produce a * result that suffers truncation at degree FMAXPOL. The value of * FMAXPOL is set by calling the function * * polini( maxpol ); * * where maxpol is the desired maximum degree. This must be * done prior to calling any of the other functions in this module. * Memory for internal temporary polynomial storage is allocated * by polini(). * * Each polynomial is represented by an array containing its * coefficients, together with a separately declared integer equal * to the degree of the polynomial. The coefficients appear in * ascending order; that is, * * 2 na * a(x) = a[0] + a[1] * x + a[2] * x + ... + a[na] * x . * * * * `a', `b', `c' are arrays of fracts. * fpoleva( a, na, &x, &sum ); Evaluate polynomial a(t) at t = x. * fpolprt( a, na, D ); Print the coefficients of a to D digits. * fpolclr( a, na ); Set a identically equal to zero, up to a[na]. * fpolmov( a, na, b ); Set b = a. * fpoladd( a, na, b, nb, c ); c = b + a, nc = max(na,nb) * fpolsub( a, na, b, nb, c ); c = b - a, nc = max(na,nb) * fpolmul( a, na, b, nb, c ); c = b * a, nc = na+nb * * * Division: * * i = fpoldiv( a, na, b, nb, c ); c = b / a, nc = FMAXPOL * * returns i = the degree of the first nonzero coefficient of a. * The computed quotient c must be divided by x^i. An error message * is printed if a is identically zero. * * * Change of variables: * If a and b are polynomials, and t = a(x), then * c(t) = b(a(x)) * is a polynomial found by substituting a(x) for t. The * subroutine call for this is * * fpolsbt( a, na, b, nb, c ); * * * Notes: * fpoldiv() is an integer routine; fpoleva() is double. * Any of the arguments a, b, c may refer to the same array. * */ #include #include "mconf.h" #ifndef NULL #define NULL 0 #endif typedef struct{ double n; double d; }fract; #ifdef ANSIPROT void exit (int); extern void radd ( fract *, fract *, fract * ); extern void rsub ( fract *, fract *, fract * ); extern void rmul ( fract *, fract *, fract * ); extern void rdiv ( fract *, fract *, fract * ); void fpolmov ( fract *, int, fract * ); void fpolmul ( fract *, int, fract *, int, fract * ); int fpoldiv ( fract *, int, fract *, int, fract * ); void * malloc ( long ); void free ( void * ); #else void exit (); void radd(), rsub(), rmul(), rdiv(); void fpolmov(), fpolmul(); int fpoldiv(); void * malloc(); void free (); #endif /* near pointer version of malloc() */ /* #define malloc _nmalloc #define free _nfree */ /* Pointers to internal arrays. Note fpoldiv() allocates * and deallocates some temporary arrays every time it is called. */ static fract *pt1 = 0; static fract *pt2 = 0; static fract *pt3 = 0; /* Maximum degree of polynomial. */ /* int FMAXPOL = 0; */ extern int FMAXPOL; /* Number of bytes (chars) in maximum size polynomial. */ static int psize = 0; /* Initialize max degree of polynomials * and allocate temporary storage. */ void fpolini( maxdeg ) int maxdeg; { FMAXPOL = maxdeg; psize = (maxdeg + 1) * sizeof(fract); /* Release previously allocated memory, if any. */ if( pt3 ) free(pt3); if( pt2 ) free(pt2); if( pt1 ) free(pt1); /* Allocate new arrays */ pt1 = (fract * )malloc(psize); /* used by fpolsbt */ pt2 = (fract * )malloc(psize); /* used by fpolsbt */ pt3 = (fract * )malloc(psize); /* used by fpolmul */ /* Report if failure */ if( (pt1 == NULL) || (pt2 == NULL) || (pt3 == NULL) ) { mtherr( "fpolini", ERANGE ); exit(1); } } /* Print the coefficients of a, with d decimal precision. */ static char *form = "abcdefghijk"; void fpolprt( a, na, d ) fract a[]; int na, d; { int i, j, d1; char *p; /* Create format descriptor string for the printout. * Do this partly by hand, since sprintf() may be too * bug-ridden to accomplish this feat by itself. */ p = form; *p++ = '%'; d1 = d + 8; sprintf( p, "%d ", d1 ); p += 1; if( d1 >= 10 ) p += 1; *p++ = '.'; sprintf( p, "%d ", d ); p += 1; if( d >= 10 ) p += 1; *p++ = 'e'; *p++ = ' '; *p++ = '\0'; /* Now do the printing. */ d1 += 1; j = 0; for( i=0; i<=na; i++ ) { /* Detect end of available line */ j += d1; if( j >= 78 ) { printf( "\n" ); j = d1; } printf( form, a[i].n ); j += d1; if( j >= 78 ) { printf( "\n" ); j = d1; } printf( form, a[i].d ); } printf( "\n" ); } /* Set a = 0. */ void fpolclr( a, n ) fract a[]; int n; { int i; if( n > FMAXPOL ) n = FMAXPOL; for( i=0; i<=n; i++ ) { a[i].n = 0.0; a[i].d = 1.0; } } /* Set b = a. */ void fpolmov( a, na, b ) fract a[], b[]; int na; { int i; if( na > FMAXPOL ) na = FMAXPOL; for( i=0; i<= na; i++ ) { b[i].n = a[i].n; b[i].d = a[i].d; } } /* c = b * a. */ void fpolmul( a, na, b, nb, c ) fract a[], b[], c[]; int na, nb; { int i, j, k, nc; fract temp; fract *p; nc = na + nb; fpolclr( pt3, FMAXPOL ); p = &a[0]; for( i=0; i<=na; i++ ) { for( j=0; j<=nb; j++ ) { k = i + j; if( k > FMAXPOL ) break; rmul( p, &b[j], &temp ); /*pt3[k] += a[i] * b[j];*/ radd( &temp, &pt3[k], &pt3[k] ); } ++p; } if( nc > FMAXPOL ) nc = FMAXPOL; for( i=0; i<=nc; i++ ) { c[i].n = pt3[i].n; c[i].d = pt3[i].d; } } /* c = b + a. */ void fpoladd( a, na, b, nb, c ) fract a[], b[], c[]; int na, nb; { int i, n; if( na > nb ) n = na; else n = nb; if( n > FMAXPOL ) n = FMAXPOL; for( i=0; i<=n; i++ ) { if( i > na ) { c[i].n = b[i].n; c[i].d = b[i].d; } else if( i > nb ) { c[i].n = a[i].n; c[i].d = a[i].d; } else { radd( &a[i], &b[i], &c[i] ); /*c[i] = b[i] + a[i];*/ } } } /* c = b - a. */ void fpolsub( a, na, b, nb, c ) fract a[], b[], c[]; int na, nb; { int i, n; if( na > nb ) n = na; else n = nb; if( n > FMAXPOL ) n = FMAXPOL; for( i=0; i<=n; i++ ) { if( i > na ) { c[i].n = b[i].n; c[i].d = b[i].d; } else if( i > nb ) { c[i].n = -a[i].n; c[i].d = a[i].d; } else { rsub( &a[i], &b[i], &c[i] ); /*c[i] = b[i] - a[i];*/ } } } /* c = b/a */ int fpoldiv( a, na, b, nb, c ) fract a[], b[], c[]; int na, nb; { fract *ta, *tb, *tq; fract quot; fract temp; int i, j, k, sing; sing = 0; /* Allocate temporary arrays. This would be quicker * if done automatically on the stack, but stack space * may be hard to obtain on a small computer. */ ta = (fract * )malloc( psize ); fpolclr( ta, FMAXPOL ); fpolmov( a, na, ta ); tb = (fract * )malloc( psize ); fpolclr( tb, FMAXPOL ); fpolmov( b, nb, tb ); tq = (fract * )malloc( psize ); fpolclr( tq, FMAXPOL ); /* What to do if leading (constant) coefficient * of denominator is zero. */ if( a[0].n == 0.0 ) { for( i=0; i<=na; i++ ) { if( ta[i].n != 0.0 ) goto nzero; } mtherr( "fpoldiv", SING ); goto done; nzero: /* Reduce the degree of the denominator. */ for( i=0; i FMAXPOL ) break; rmul( &ta[j], ", &temp ); /*tb[k] -= quot * ta[j];*/ rsub( &temp, &tb[k], &tb[k] ); } tq[i].n = quot.n; tq[i].d = quot.d; } /* Send quotient to output array. */ fpolmov( tq, FMAXPOL, c ); done: /* Restore allocated memory. */ free(tq); free(tb); free(ta); return( sing ); } /* Change of variables * Substitute a(y) for the variable x in b(x). * x = a(y) * c(x) = b(x) = b(a(y)). */ void fpolsbt( a, na, b, nb, c ) fract a[], b[], c[]; int na, nb; { int i, j, k, n2; fract temp; fract *p; /* 0th degree term: */ fpolclr( pt1, FMAXPOL ); pt1[0].n = b[0].n; pt1[0].d = b[0].d; fpolclr( pt2, FMAXPOL ); pt2[0].n = 1.0; pt2[0].d = 1.0; n2 = 0; p = &b[1]; for( i=1; i<=nb; i++ ) { /* Form ith power of a. */ fpolmul( a, na, pt2, n2, pt2 ); n2 += na; /* Add the ith coefficient of b times the ith power of a. */ for( j=0; j<=n2; j++ ) { if( j > FMAXPOL ) break; rmul( &pt2[j], p, &temp ); /*pt1[j] += b[i] * pt2[j];*/ radd( &temp, &pt1[j], &pt1[j] ); } ++p; } k = n2 + nb; if( k > FMAXPOL ) k = FMAXPOL; for( i=0; i<=k; i++ ) { c[i].n = pt1[i].n; c[i].d = pt1[i].d; } } /* Evaluate polynomial a(t) at t = x. */ void fpoleva( a, na, x, s ) fract a[]; int na; fract *x; fract *s; { int i; fract temp; s->n = a[na].n; s->d = a[na].d; for( i=na-1; i>=0; i-- ) { rmul( s, x, &temp ); /*s = s * x + a[i];*/ radd( &a[i], &temp, s ); } } Math-Cephes-0.5306/libmd/mconf.h0000644000175000017500000000644214757250372016155 0ustar shlomifshlomif /* Cephes Math Library Release 2.3: June, 1995 Copyright 1984, 1987, 1989, 1995 by Stephen L. Moshier */ /* Define if the `long double' type works. */ #define HAVE_LONG_DOUBLE 1 /* Define as the return type of signal handlers (int or void). */ #define RETSIGTYPE void /* Define if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Define if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel and VAX). */ /* #define WORDS_BIGENDIAN */ /* Define if floating point words are bigendian. */ /* #define FLOAT_WORDS_BIGENDIAN */ /* The number of bytes in a int. */ #define SIZEOF_INT 4 /* Define if you have the header file. */ #define HAVE_MALLOC_H 1 /* Define if you have the header file. */ #define HAVE_STRING_H 1 /* Name of package */ #define PACKAGE "cephes" /* Version number of package */ #define VERSION_CEPHES "2.7" /* Constant definitions for math error conditions */ #define DOMAIN 1 /* argument domain error */ #define SING 2 /* argument singularity */ #define OVERFLOW 3 /* overflow range error */ #define UNDERFLOW 4 /* underflow range error */ #define TLOSS 5 /* total loss of precision */ #define PLOSS 6 /* partial loss of precision */ #define EDOM 33 #define ERANGE 34 /* Complex numeral. */ typedef struct { double r; double i; } cmplx; #ifdef HAVE_LONG_DOUBLE /* Long double complex numeral. */ typedef struct { long double r; long double i; } cmplxl; #endif /* Type of computer arithmetic */ /* PDP-11, Pro350, VAX: */ /* #define DEC 1 */ /* Intel IEEE, low order words come first: */ /* #define IBMPC 1 */ /* Motorola IEEE, high order words come first * (Sun 680x0 workstation): */ /* #define MIEEE 1 */ /* UNKnown arithmetic, invokes coefficients given in * normal decimal format. Beware of range boundary * problems (MACHEP, MAXLOG, etc. in const.c) and * roundoff problems in pow.c: * (Sun SPARCstation) */ #define UNK 1 /* If you define UNK, then be sure to set BIGENDIAN properly. */ #ifdef FLOAT_WORDS_BIGENDIAN #define BIGENDIAN 1 #else #define BIGENDIAN 0 #endif /* Define this `volatile' if your compiler thinks * that floating point arithmetic obeys the associative * and distributive laws. It will defeat some optimizations * (but probably not enough of them). * */ #define VOLATILE /* For 12-byte long doubles on an i386, pad a 16-bit short 0 * to the end of real constants initialized by integer arrays. * * #define XPD 0, * * Otherwise, the type is 10 bytes long and XPD should be * defined blank (e.g., Microsoft C). * * #define XPD */ #define XPD /* Define to support tiny denormal numbers, else undefine. */ #define DENORMAL 1 /* Define to ask for infinity support, else undefine. */ #define INFINITIES 1 /* Define to ask for support of numbers that are Not-a-Number, else undefine. This may automatically define INFINITIES in some files. */ #define NANS 1 /* Define to distinguish between -0.0 and +0.0. */ #define MINUSZERO 1 /* Define 1 for ANSI C atan2() function See atan.c and clog.c. */ #define ANSIC 1 /* Get ANSI function prototypes, if you want them. */ #ifdef __STDC__ #define ANSIPROT /* #include "protos.h" */ int mtherr(char *, int); #else int mtherr(); #endif /* Variable for error reporting. See mtherr.c. */ extern int merror; Math-Cephes-0.5306/libmd/zeta.c0000644000175000017500000000636014757021403015777 0ustar shlomifshlomif/* zeta.c * * Riemann zeta function of two arguments * * * * SYNOPSIS: * * double x, q, y, zeta(); * * y = zeta( x, q ); * * * * DESCRIPTION: * * * * inf. * - -x * zeta(x,q) = > (k+q) * - * k=0 * * where x > 1 and q is not a negative integer or zero. * The Euler-Maclaurin summation formula is used to obtain * the expansion * * n * - -x * zeta(x,q) = > (k+q) * - * k=1 * * 1-x inf. B x(x+1)...(x+2j) * (n+q) 1 - 2j * + --------- - ------- + > -------------------- * x-1 x - x+2j+1 * 2(n+q) j=1 (2j)! (n+q) * * where the B2j are Bernoulli numbers. Note that (see zetac.c) * zeta(x,1) = zetac(x) + 1. * * * * ACCURACY: * * * * REFERENCE: * * Gradshteyn, I. S., and I. M. Ryzhik, Tables of Integrals, * Series, and Products, p. 1073; Academic Press, 1980. * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double md_fabs ( double ); extern double md_pow ( double, double ); extern double md_floor ( double ); #else double md_fabs(), md_pow(), md_floor(); #endif extern double MAXNUM, MACHEP; /* Expansion coefficients * for Euler-Maclaurin summation formula * (2k)! / B2k * where B2k are Bernoulli numbers */ static double A[] = { 12.0, -720.0, 30240.0, -1209600.0, 47900160.0, -1.8924375803183791606e9, /*1.307674368e12/691*/ 7.47242496e10, -2.950130727918164224e12, /*1.067062284288e16/3617*/ 1.1646782814350067249e14, /*5.109094217170944e18/43867*/ -4.5979787224074726105e15, /*8.028576626982912e20/174611*/ 1.8152105401943546773e17, /*1.5511210043330985984e23/854513*/ -7.1661652561756670113e18 /*1.6938241367317436694528e27/236364091*/ }; /* 30 Nov 86 -- error in third coefficient fixed */ double zeta(x,q) double x,q; { int i; double a, b, k, s, t, w; if( x == 1.0 ) goto retinf; if( x < 1.0 ) { domerr: mtherr( "zeta", DOMAIN ); return(0.0); } if( q <= 0.0 ) { if(q == md_floor(q)) { mtherr( "zeta", SING ); retinf: return( MAXNUM ); } if( x != md_floor(x) ) goto domerr; /* because q^-x not defined */ } /* Euler-Maclaurin summation formula */ /* if( x < 25.0 ) */ { /* Permit negative q but continue sum until n+q > +9 . * This case should be handled by a reflection formula. * If q<0 and x is an integer, there is a relation to * the polygamma function. */ s = md_pow( q, -x ); a = q; i = 0; b = 0.0; while( (i < 9) || (a <= 9.0) ) { i += 1; a += 1.0; b = md_pow( a, -x ); s += b; if( md_fabs(b/s) < MACHEP ) goto done; } w = a; s += b*w/(x-1.0); s -= 0.5 * b; a = 1.0; k = 0.0; for( i=0; i<12; i++ ) { a *= x + k; b /= w; t = a*b/A[i]; s = s + t; t = md_fabs(t/s); if( t < MACHEP ) goto done; k += 1.0; a *= x + k; b /= w; k += 1.0; } done: return(s); } /* Basic sum of inverse powers */ /* pseres: s = md_pow( q, -x ); a = q; do { a += 2.0; b = md_pow( a, -x ); s += b; } while( b/s > MACHEP ); b = md_pow( 2.0, -x ); s = (s + b)/(1.0-b); return(s); */ } Math-Cephes-0.5306/libmd/pow.c0000644000175000017500000003573014757021403015644 0ustar shlomifshlomif/* md_pow.c * * Power function * * * * SYNOPSIS: * * double x, y, z, md_pow(); * * z = md_pow( x, y ); * * * * DESCRIPTION: * * Computes x raised to the yth power. Analytically, * * x**y = md_exp( y md_log(x) ). * * Following Cody and Waite, this program uses a lookup table * of 2**-i/16 and pseudo extended precision arithmetic to * obtain an extra three bits of accuracy in both the logarithm * and the exponential. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -26,26 30000 4.2e-16 7.7e-17 * DEC -26,26 60000 4.8e-17 9.1e-18 * 1/26 < x < 26, with md_log(x) uniformly distributed. * -26 < y < 26, y uniformly distributed. * IEEE 0,8700 30000 1.5e-14 2.1e-15 * 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed. * * * ERROR MESSAGES: * * message condition value returned * md_pow overflow x**y > MAXNUM INFINITY * md_pow underflow x**y < 1/MAXNUM 0.0 * md_pow domain x<0 and y noninteger 0.0 * */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" static char fname[] = {"md_pow"}; #define SQRTH 0.70710678118654752440 #ifdef UNK static double P[] = { 4.97778295871696322025E-1, 3.73336776063286838734E0, 7.69994162726912503298E0, 4.66651806774358464979E0 }; static double Q[] = { /* 1.00000000000000000000E0, */ 9.33340916416696166113E0, 2.79999886606328401649E1, 3.35994905342304405431E1, 1.39995542032307539578E1 }; /* 2^(-i/16), IEEE precision */ static double A[] = { 1.00000000000000000000E0, 9.57603280698573700036E-1, 9.17004043204671215328E-1, 8.78126080186649726755E-1, 8.40896415253714502036E-1, 8.05245165974627141736E-1, 7.71105412703970372057E-1, 7.38413072969749673113E-1, 7.07106781186547572737E-1, 6.77127773468446325644E-1, 6.48419777325504820276E-1, 6.20928906036742001007E-1, 5.94603557501360513449E-1, 5.69394317378345782288E-1, 5.45253866332628844837E-1, 5.22136891213706877402E-1, 5.00000000000000000000E-1 }; static double B[] = { 0.00000000000000000000E0, 1.64155361212281360176E-17, 4.09950501029074826006E-17, 3.97491740484881042808E-17, -4.83364665672645672553E-17, 1.26912513974441574796E-17, 1.99100761573282305549E-17, -1.52339103990623557348E-17, 0.00000000000000000000E0 }; static double R[] = { 1.49664108433729301083E-5, 1.54010762792771901396E-4, 1.33335476964097721140E-3, 9.61812908476554225149E-3, 5.55041086645832347466E-2, 2.40226506959099779976E-1, 6.93147180559945308821E-1 }; #define douba(k) A[k] #define doubb(k) B[k] #define MEXP 16383.0 #ifdef DENORMAL #define MNEXP -17183.0 #else #define MNEXP -16383.0 #endif #endif #ifdef DEC static unsigned short P[] = { 0037776,0156313,0175332,0163602, 0040556,0167577,0052366,0174245, 0040766,0062753,0175707,0055564, 0040625,0052035,0131344,0155636, }; static unsigned short Q[] = { /*0040200,0000000,0000000,0000000,*/ 0041025,0052644,0154404,0105155, 0041337,0177772,0007016,0047646, 0041406,0062740,0154273,0020020, 0041137,0177054,0106127,0044555, }; static unsigned short A[] = { 0040200,0000000,0000000,0000000, 0040165,0022575,0012444,0103314, 0040152,0140306,0163735,0022071, 0040140,0146336,0166052,0112341, 0040127,0042374,0145326,0116553, 0040116,0022214,0012437,0102201, 0040105,0063452,0010525,0003333, 0040075,0004243,0117530,0006067, 0040065,0002363,0031771,0157145, 0040055,0054076,0165102,0120513, 0040045,0177326,0124661,0050471, 0040036,0172462,0060221,0120422, 0040030,0033760,0050615,0134251, 0040021,0141723,0071653,0010703, 0040013,0112701,0161752,0105727, 0040005,0125303,0063714,0044173, 0040000,0000000,0000000,0000000 }; static unsigned short B[] = { 0000000,0000000,0000000,0000000, 0021473,0040265,0153315,0140671, 0121074,0062627,0042146,0176454, 0121413,0003524,0136332,0066212, 0121767,0046404,0166231,0012553, 0121257,0015024,0002357,0043574, 0021736,0106532,0043060,0056206, 0121310,0020334,0165705,0035326, 0000000,0000000,0000000,0000000 }; static unsigned short R[] = { 0034173,0014076,0137624,0115771, 0035041,0076763,0003744,0111311, 0035656,0141766,0041127,0074351, 0036435,0112533,0073611,0116664, 0037143,0054106,0134040,0152223, 0037565,0176757,0176026,0025551, 0040061,0071027,0173721,0147572 }; /* static double R[] = { 0.14928852680595608186e-4, 0.15400290440989764601e-3, 0.13333541313585784703e-2, 0.96181290595172416964e-2, 0.55504108664085595326e-1, 0.24022650695909537056e0, 0.69314718055994529629e0 }; */ #define douba(k) (*(double *)&A[(k)<<2]) #define doubb(k) (*(double *)&B[(k)<<2]) #define MEXP 2031.0 #define MNEXP -2031.0 #endif #ifdef IBMPC static unsigned short P[] = { 0x5cf0,0x7f5b,0xdb99,0x3fdf, 0xdf15,0xea9e,0xddef,0x400d, 0xeb6f,0x7f78,0xccbd,0x401e, 0x9b74,0xb65c,0xaa83,0x4012, }; static unsigned short Q[] = { /*0x0000,0x0000,0x0000,0x3ff0,*/ 0x914e,0x9b20,0xaab4,0x4022, 0xc9f5,0x41c1,0xffff,0x403b, 0x6402,0x1b17,0xccbc,0x4040, 0xe92e,0x918a,0xffc5,0x402b, }; static unsigned short A[] = { 0x0000,0x0000,0x0000,0x3ff0, 0x90da,0xa2a4,0xa4af,0x3fee, 0xa487,0xdcfb,0x5818,0x3fed, 0x529c,0xdd85,0x199b,0x3fec, 0xd3ad,0x995a,0xe89f,0x3fea, 0xf090,0x82a3,0xc491,0x3fe9, 0xa0db,0x422a,0xace5,0x3fe8, 0x0187,0x73eb,0xa114,0x3fe7, 0x3bcd,0x667f,0xa09e,0x3fe6, 0x5429,0xdd48,0xab07,0x3fe5, 0x2a27,0xd536,0xbfda,0x3fe4, 0x3422,0x4c12,0xdea6,0x3fe3, 0xb715,0x0a31,0x06fe,0x3fe3, 0x6238,0x6e75,0x387a,0x3fe2, 0x517b,0x3c7d,0x72b8,0x3fe1, 0x890f,0x6cf9,0xb558,0x3fe0, 0x0000,0x0000,0x0000,0x3fe0 }; static unsigned short B[] = { 0x0000,0x0000,0x0000,0x0000, 0x3707,0xd75b,0xed02,0x3c72, 0xcc81,0x345d,0xa1cd,0x3c87, 0x4b27,0x5686,0xe9f1,0x3c86, 0x6456,0x13b2,0xdd34,0xbc8b, 0x42e2,0xafec,0x4397,0x3c6d, 0x82e4,0xd231,0xf46a,0x3c76, 0x8a76,0xb9d7,0x9041,0xbc71, 0x0000,0x0000,0x0000,0x0000 }; static unsigned short R[] = { 0x937f,0xd7f2,0x6307,0x3eef, 0x9259,0x60fc,0x2fbe,0x3f24, 0xef1d,0xc84a,0xd87e,0x3f55, 0x33b7,0x6ef1,0xb2ab,0x3f83, 0x1a92,0xd704,0x6b08,0x3fac, 0xc56d,0xff82,0xbfbd,0x3fce, 0x39ef,0xfefa,0x2e42,0x3fe6 }; #define douba(k) (*(double *)&A[(k)<<2]) #define doubb(k) (*(double *)&B[(k)<<2]) #define MEXP 16383.0 #ifdef DENORMAL #define MNEXP -17183.0 #else #define MNEXP -16383.0 #endif #endif #ifdef MIEEE static unsigned short P[] = { 0x3fdf,0xdb99,0x7f5b,0x5cf0, 0x400d,0xddef,0xea9e,0xdf15, 0x401e,0xccbd,0x7f78,0xeb6f, 0x4012,0xaa83,0xb65c,0x9b74 }; static unsigned short Q[] = { 0x4022,0xaab4,0x9b20,0x914e, 0x403b,0xffff,0x41c1,0xc9f5, 0x4040,0xccbc,0x1b17,0x6402, 0x402b,0xffc5,0x918a,0xe92e }; static unsigned short A[] = { 0x3ff0,0x0000,0x0000,0x0000, 0x3fee,0xa4af,0xa2a4,0x90da, 0x3fed,0x5818,0xdcfb,0xa487, 0x3fec,0x199b,0xdd85,0x529c, 0x3fea,0xe89f,0x995a,0xd3ad, 0x3fe9,0xc491,0x82a3,0xf090, 0x3fe8,0xace5,0x422a,0xa0db, 0x3fe7,0xa114,0x73eb,0x0187, 0x3fe6,0xa09e,0x667f,0x3bcd, 0x3fe5,0xab07,0xdd48,0x5429, 0x3fe4,0xbfda,0xd536,0x2a27, 0x3fe3,0xdea6,0x4c12,0x3422, 0x3fe3,0x06fe,0x0a31,0xb715, 0x3fe2,0x387a,0x6e75,0x6238, 0x3fe1,0x72b8,0x3c7d,0x517b, 0x3fe0,0xb558,0x6cf9,0x890f, 0x3fe0,0x0000,0x0000,0x0000 }; static unsigned short B[] = { 0x0000,0x0000,0x0000,0x0000, 0x3c72,0xed02,0xd75b,0x3707, 0x3c87,0xa1cd,0x345d,0xcc81, 0x3c86,0xe9f1,0x5686,0x4b27, 0xbc8b,0xdd34,0x13b2,0x6456, 0x3c6d,0x4397,0xafec,0x42e2, 0x3c76,0xf46a,0xd231,0x82e4, 0xbc71,0x9041,0xb9d7,0x8a76, 0x0000,0x0000,0x0000,0x0000 }; static unsigned short R[] = { 0x3eef,0x6307,0xd7f2,0x937f, 0x3f24,0x2fbe,0x60fc,0x9259, 0x3f55,0xd87e,0xc84a,0xef1d, 0x3f83,0xb2ab,0x6ef1,0x33b7, 0x3fac,0x6b08,0xd704,0x1a92, 0x3fce,0xbfbd,0xff82,0xc56d, 0x3fe6,0x2e42,0xfefa,0x39ef }; #define douba(k) (*(double *)&A[(k)<<2]) #define doubb(k) (*(double *)&B[(k)<<2]) #define MEXP 16383.0 #ifdef DENORMAL #define MNEXP -17183.0 #else #define MNEXP -16383.0 #endif #endif /* md_log2(e) - 1 */ #define LOG2EA 0.44269504088896340736 #define F W #define Fa Wa #define Fb Wb #define G W #define Ga Wa #define Gb u #define H W #define Ha Wb #define Hb Wb #ifdef ANSIPROT extern double md_floor ( double ); extern double md_fabs ( double ); extern double md_frexp ( double, int * ); extern double md_ldexp ( double, int ); extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_powi ( double, int ); extern int signbit ( double ); extern int isnan ( double ); extern int isfinite ( double ); static double reduc ( double ); #else double md_floor(), md_fabs(), md_frexp(), md_ldexp(); double polevl(), p1evl(), md_powi(); int signbit(), isnan(), isfinite(); static double reduc(); #endif extern double MAXNUM; #ifdef INFINITIES extern double INFINITY; #endif #ifdef NANS extern double NAN; #endif #ifdef MINUSZERO extern double NEGZERO; #endif double md_pow( x, y ) double x, y; { double w, z, W, Wa, Wb, ya, yb, u; /* double F, Fa, Fb, G, Ga, Gb, H, Ha, Hb */ double aw, ay, wy; int e, i, nflg, iyflg, yoddint; if( y == 0.0 ) return( 1.0 ); #ifdef NANS if( isnan(x) ) return( x ); if( isnan(y) ) return( y ); #endif if( y == 1.0 ) return( x ); #ifdef INFINITIES if( !isfinite(y) && (x == 1.0 || x == -1.0) ) { mtherr( "md_pow", DOMAIN ); #ifdef NANS return( NAN ); #else return( INFINITY ); #endif } #endif if( x == 1.0 ) return( 1.0 ); if( y >= MAXNUM ) { #ifdef INFINITIES if( x > 1.0 ) return( INFINITY ); #else if( x > 1.0 ) return( MAXNUM ); #endif if( x > 0.0 && x < 1.0 ) return( 0.0); if( x < -1.0 ) { #ifdef INFINITIES return( INFINITY ); #else return( MAXNUM ); #endif } if( x > -1.0 && x < 0.0 ) return( 0.0 ); } if( y <= -MAXNUM ) { if( x > 1.0 ) return( 0.0 ); #ifdef INFINITIES if( x > 0.0 && x < 1.0 ) return( INFINITY ); #else if( x > 0.0 && x < 1.0 ) return( MAXNUM ); #endif if( x < -1.0 ) return( 0.0 ); #ifdef INFINITIES if( x > -1.0 && x < 0.0 ) return( INFINITY ); #else if( x > -1.0 && x < 0.0 ) return( MAXNUM ); #endif } if( x >= MAXNUM ) { #if INFINITIES if( y > 0.0 ) return( INFINITY ); #else if( y > 0.0 ) return( MAXNUM ); #endif return(0.0); } /* Set iyflg to 1 if y is an integer. */ iyflg = 0; w = md_floor(y); if( w == y ) iyflg = 1; /* Test for odd integer y. */ yoddint = 0; if( iyflg ) { ya = md_fabs(y); ya = md_floor(0.5 * ya); yb = 0.5 * md_fabs(w); if( ya != yb ) yoddint = 1; } if( x <= -MAXNUM ) { if( y > 0.0 ) { #ifdef INFINITIES if( yoddint ) return( -INFINITY ); return( INFINITY ); #else if( yoddint ) return( -MAXNUM ); return( MAXNUM ); #endif } if( y < 0.0 ) { #ifdef MINUSZERO if( yoddint ) return( NEGZERO ); #endif return( 0.0 ); } } nflg = 0; /* flag = 1 if x<0 raised to integer power */ if( x <= 0.0 ) { if( x == 0.0 ) { if( y < 0.0 ) { #ifdef MINUSZERO if( signbit(x) && yoddint ) return( -INFINITY ); #endif #ifdef INFINITIES return( INFINITY ); #else return( MAXNUM ); #endif } if( y > 0.0 ) { #ifdef MINUSZERO if( signbit(x) && yoddint ) return( NEGZERO ); #endif return( 0.0 ); } return( 1.0 ); } else { if( iyflg == 0 ) { /* noninteger power of negative number */ mtherr( fname, DOMAIN ); #ifdef NANS return(NAN); #else return(0.0L); #endif } nflg = 1; } } /* Integer power of an integer. */ if( iyflg ) { i = w; w = md_floor(x); if( (w == x) && (md_fabs(y) < 32768.0) ) { w = md_powi( x, (int) y ); return( w ); } } if( nflg ) x = md_fabs(x); /* For results close to 1, use a series expansion. */ w = x - 1.0; aw = md_fabs(w); ay = md_fabs(y); wy = w * y; ya = md_fabs(wy); if((aw <= 1.0e-3 && ay <= 1.0) || (ya <= 1.0e-3 && ay >= 1.0)) { z = (((((w*(y-5.)/720. + 1./120.)*w*(y-4.) + 1./24.)*w*(y-3.) + 1./6.)*w*(y-2.) + 0.5)*w*(y-1.) )*wy + wy + 1.; goto done; } /* These are probably too much trouble. */ #if 0 w = y * md_log(x); if (aw > 1.0e-3 && md_fabs(w) < 1.0e-3) { z = (((((( w/7. + 1.)*w/6. + 1.)*w/5. + 1.)*w/4. + 1.)*w/3. + 1.)*w/2. + 1.)*w + 1.; goto done; } if(ya <= 1.0e-3 && aw <= 1.0e-4) { z = ((((( wy*1./720. + (-w*1./48. + 1./120.) )*wy + ((w*17./144. - 1./12.)*w + 1./24.) )*wy + (((-w*5./16. + 7./24.)*w - 1./4.)*w + 1./6.) )*wy + ((((w*137./360. - 5./12.)*w + 11./24.)*w - 1./2.)*w + 1./2.) )*wy + (((((-w*1./6. + 1./5.)*w - 1./4)*w + 1./3.)*w -1./2.)*w ) )*wy + wy + 1.0; goto done; } #endif /* separate significand from exponent */ x = md_frexp( x, &e ); #if 0 /* For debugging, check for gross overflow. */ if( (e * y) > (MEXP + 1024) ) goto overflow; #endif /* Find significand of x in antilog table A[]. */ i = 1; if( x <= douba(9) ) i = 9; if( x <= douba(i+4) ) i += 4; if( x <= douba(i+2) ) i += 2; if( x >= douba(1) ) i = -1; i += 1; /* Find (x - A[i])/A[i] * in order to compute md_log(x/A[i]): * * md_log(x) = md_log( a x/a ) = md_log(a) + md_log(x/a) * * md_log(x/a) = md_log(1+v), v = x/a - 1 = (x-a)/a */ x -= douba(i); x -= doubb(i/2); x /= douba(i); /* rational approximation for md_log(1+v): * * md_log(1+v) = v - v**2/2 + v**3 P(v) / Q(v) */ z = x*x; w = x * ( z * polevl( x, P, 3 ) / p1evl( x, Q, 4 ) ); w = w - md_ldexp( z, -1 ); /* w - 0.5 * z */ /* Convert to base 2 logarithm: * multiply by md_log2(e) */ w = w + LOG2EA * w; /* Note x was not yet added in * to above rational approximation, * so do it now, while multiplying * by md_log2(e). */ z = w + LOG2EA * x; z = z + x; /* Compute exponent term of the base 2 logarithm. */ w = -i; w = md_ldexp( w, -4 ); /* divide by 16 */ w += e; /* Now base 2 md_log of x is w + z. */ /* Multiply base 2 md_log by y, in extended precision. */ /* separate y into large part ya * and small part yb less than 1/16 */ ya = reduc(y); yb = y - ya; F = z * y + w * yb; Fa = reduc(F); Fb = F - Fa; G = Fa + w * ya; Ga = reduc(G); Gb = G - Ga; H = Fb + Gb; Ha = reduc(H); w = md_ldexp( Ga+Ha, 4 ); /* Test the power of 2 for overflow */ if( w > MEXP ) { #ifndef INFINITIES mtherr( fname, OVERFLOW ); #endif #ifdef INFINITIES if( nflg && yoddint ) return( -INFINITY ); return( INFINITY ); #else if( nflg && yoddint ) return( -MAXNUM ); return( MAXNUM ); #endif } if( w < (MNEXP - 1) ) { #ifndef DENORMAL mtherr( fname, UNDERFLOW ); #endif #ifdef MINUSZERO if( nflg && yoddint ) return( NEGZERO ); #endif return( 0.0 ); } e = w; Hb = H - Ha; if( Hb > 0.0 ) { e += 1; Hb -= 0.0625; } /* Now the product y * md_log2(x) = Hb + e/16.0. * * Compute base 2 exponential of Hb, * where -0.0625 <= Hb <= 0. */ z = Hb * polevl( Hb, R, 6 ); /* z = 2**Hb - 1 */ /* Express e/16 as an integer plus a negative number of 16ths. * Find lookup table entry for the fractional power of 2. */ if( e < 0 ) i = 0; else i = 1; i = e/16 + i; e = 16*i - e; w = douba( e ); z = w + w * z; /* 2**-e * ( 1 + (2**Hb-1) ) */ z = md_ldexp( z, i ); /* multiply by integer power of 2 */ done: /* Negate if odd integer power of negative number */ if( nflg && yoddint ) { #ifdef MINUSZERO if( z == 0.0 ) z = NEGZERO; else #endif z = -z; } return( z ); } /* Find a multiple of 1/16 that is within 1/16 of x. */ static double reduc(x) double x; { double t; t = md_ldexp( x, 4 ); t = md_floor( t ); t = md_ldexp( t, -4 ); return(t); } Math-Cephes-0.5306/libmd/hyperg.c0000644000175000017500000001645514757021403016340 0ustar shlomifshlomif/* hyperg.c * * Confluent hypergeometric function * * * * SYNOPSIS: * * double a, b, x, y, hyperg(); * * y = hyperg( a, b, x ); * * * * DESCRIPTION: * * Computes the confluent hypergeometric function * * 1 2 * a x a(a+1) x * F ( a,b;x ) = 1 + ---- + --------- + ... * 1 1 b 1! b(b+1) 2! * * Many higher transcendental functions are special cases of * this power series. * * As is evident from the formula, b must not be a negative * integer or zero unless a is an integer with 0 >= a > b. * * The routine attempts both a direct summation of the series * and an asymptotic expansion. In each case error due to * roundoff, cancellation, and nonconvergence is estimated. * The result with smaller estimated error is returned. * * * * ACCURACY: * * Tested at random points (a, b, x), all three variables * ranging from 0 to 30. * Relative error: * arithmetic domain # trials peak rms * DEC 0,30 2000 1.2e-15 1.3e-16 qtst1: 21800 max = 1.4200E-14 rms = 1.0841E-15 ave = -5.3640E-17 ltstd: 25500 max = 1.2759e-14 rms = 3.7155e-16 ave = 1.5384e-18 * IEEE 0,30 30000 1.8e-14 1.1e-15 * * Larger errors can be observed when b is near a negative * integer or zero. Certain combinations of arguments yield * serious cancellation error in the power series summation * and also are not in the region of near convergence of the * asymptotic series. An error message is printed if the * self-estimated relative error is greater than 1.0e-12. * */ /* hyperg.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT extern double md_exp ( double ); extern double md_log ( double ); extern double md_gamma ( double ); extern double lgam ( double ); extern double md_fabs ( double ); double hyp2f0 ( double, double, double, int, double * ); static double hy1f1p(double, double, double, double *); static double hy1f1a(double, double, double, double *); double hyperg (double, double, double); #else double md_exp(), md_log(), md_gamma(), lgam(), md_fabs(), hyp2f0(); static double hy1f1p(); static double hy1f1a(); double hyperg(); #endif extern double MAXNUM, MACHEP; double hyperg( a, b, x) double a, b, x; { double asum, psum, acanc, pcanc, temp; /* See if a Kummer transformation will help */ temp = b - a; if( md_fabs(temp) < 0.001 * md_fabs(a) ) return( md_exp(x) * hyperg( temp, b, -x ) ); psum = hy1f1p( a, b, x, &pcanc ); if( pcanc < 1.0e-15 ) goto done; /* try asymptotic series */ asum = hy1f1a( a, b, x, &acanc ); /* Pick the result with less estimated error */ if( acanc < pcanc ) { pcanc = acanc; psum = asum; } done: if( pcanc > 1.0e-12 ) mtherr( "hyperg", PLOSS ); return( psum ); } /* Power series summation for confluent hypergeometric function */ static double hy1f1p( a, b, x, err ) double a, b, x; double *err; { double n, a0, sum, t, u, temp; double an, bn, maxt, pcanc; /* set up for power series summation */ an = a; bn = b; a0 = 1.0; sum = 1.0; n = 1.0; t = 1.0; maxt = 0.0; pcanc = 0.0; while( t > MACHEP ) { if( bn == 0 ) /* check bn first since if both */ { mtherr( "hyperg", SING ); return( MAXNUM ); /* an and bn are zero it is */ } if( an == 0 ) /* a singularity */ return( sum ); if( n > 200 ) goto pdone; u = x * ( an / (bn * n) ); /* check for blowup */ temp = md_fabs(u); if( (temp > 1.0 ) && (maxt > (MAXNUM/temp)) ) { pcanc = 1.0; /* estimate 100% error */ goto blowup; } a0 *= u; sum += a0; t = md_fabs(a0); if( t > maxt ) maxt = t; /* if( (maxt/md_fabs(sum)) > 1.0e17 ) { pcanc = 1.0; goto blowup; } */ an += 1.0; bn += 1.0; n += 1.0; } pdone: /* estimate error due to roundoff and cancellation */ t = md_fabs(sum); /* If the largest term is large and bigger than the sum, don't believe it */ if( (t > 1.0) && (maxt > t) ) goto blowup; if( t != 0.0) maxt /= t; maxt *= MACHEP; /* this way avoids multiply overflow */ pcanc = md_fabs( MACHEP * n + maxt ); blowup: *err = pcanc; return( sum ); } /* hy1f1a() */ /* asymptotic formula for hypergeometric function: * * ( -a * -- ( |z| * | (b) ( -------- 2f0( a, 1+a-b, -1/x ) * ( -- * ( | (b-a) * * * x a-b ) * e |x| ) * + -------- 2f0( b-a, 1-a, 1/x ) ) * -- ) * | (a) ) */ static double hy1f1a( a, b, x, err ) double a, b, x; double *err; { double h1, h2, t, u, temp, acanc, asum, err1, err2; if( x == 0 ) { acanc = 1.0; asum = MAXNUM; goto adone; } temp = md_log( md_fabs(x) ); t = x + temp * (a-b); u = -temp * a; if( b > 0 ) { temp = lgam(b); t += temp; u += temp; } h1 = hyp2f0( a, a-b+1, -1.0/x, 1, &err1 ); temp = md_exp(u) / md_gamma(b-a); h1 *= temp; err1 *= temp; h2 = hyp2f0( b-a, 1.0-a, 1.0/x, 2, &err2 ); if( a < 0 ) temp = md_exp(t) / md_gamma(a); else temp = md_exp( t - lgam(a) ); h2 *= temp; err2 *= temp; if( x < 0.0 ) asum = h1; else asum = h2; acanc = md_fabs(err1) + md_fabs(err2); if( b < 0 ) { temp = md_gamma(b); asum *= temp; acanc *= md_fabs(temp); } if( asum != 0.0 ) acanc /= md_fabs(asum); acanc *= 30.0; /* fudge factor, since error of asymptotic formula * often seems this much larger than advertised */ adone: *err = acanc; return( asum ); } /* hyp2f0() */ double hyp2f0( a, b, x, type, err ) double a, b, x; int type; /* determines what converging factor to use */ double *err; { double a0, alast, t, tlast, maxt; double n, an, bn, u, sum, temp; an = a; bn = b; a0 = 1.0e0; alast = 1.0e0; sum = 0.0; n = 1.0e0; t = 1.0e0; tlast = 1.0e9; maxt = 0.0; do { if( an == 0 ) goto pdone; if( bn == 0 ) goto pdone; u = an * (bn * x / n); /* check for blowup */ temp = md_fabs(u); if( (temp > 1.0 ) && (maxt > (MAXNUM/temp)) ) goto error; a0 *= u; t = md_fabs(a0); /* terminating condition for asymptotic series */ if( t > tlast ) goto ndone; tlast = t; sum += alast; /* the sum is one term behind */ alast = a0; if( n > 200 ) goto ndone; an += 1.0e0; bn += 1.0e0; n += 1.0e0; if( t > maxt ) maxt = t; } while( t > MACHEP ); pdone: /* series converged! */ /* estimate error due to roundoff and cancellation */ *err = md_fabs( MACHEP * (n + maxt) ); alast = a0; goto done; ndone: /* series did not converge */ /* The following "Converging factors" are supposed to improve accuracy, * but do not actually seem to accomplish very much. */ n -= 1.0; x = 1.0/x; switch( type ) /* "type" given as subroutine argument */ { case 1: alast *= ( 0.5 + (0.125 + 0.25*b - 0.5*a + 0.25*x - 0.25*n)/x ); break; case 2: alast *= 2.0/3.0 - b + 2.0*a + x - n; break; default: ; } /* estimate error due to roundoff, cancellation, and nonconvergence */ *err = MACHEP * (n + maxt) + md_fabs ( a0 ); done: sum += alast; return( sum ); /* series blew up: */ error: *err = MAXNUM; mtherr( "hyperg", TLOSS ); return( sum ); } Math-Cephes-0.5306/libmd/setprec.c.unix0000644000175000017500000000020314757021403017451 0ustar shlomifshlomif/* Null stubs for coprocessor precision settings */ int sprec() {return 0; } int dprec() {return 0; } int ldprec() {return 0; } Math-Cephes-0.5306/libmd/i0.c0000644000175000017500000002175514757021403015351 0ustar shlomifshlomif/* i0.c * * Modified Bessel function of order zero * * * * SYNOPSIS: * * double x, y, i0(); * * y = i0( x ); * * * * DESCRIPTION: * * Returns modified Bessel function of order zero of the * argument. * * The function is defined as i0(x) = md_j0( ix ). * * The range is partitioned into the two intervals [0,8] and * (8, infinity). Chebyshev polynomial expansions are employed * in each interval. * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 0,30 6000 8.2e-17 1.9e-17 * IEEE 0,30 30000 5.8e-16 1.4e-16 * */ /* i0e.c * * Modified Bessel function of order zero, * exponentially scaled * * * * SYNOPSIS: * * double x, y, i0e(); * * y = i0e( x ); * * * * DESCRIPTION: * * Returns exponentially scaled modified Bessel function * of order zero of the argument. * * The function is defined as i0e(x) = md_exp(-|x|) md_j0( ix ). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE 0,30 30000 5.4e-16 1.2e-16 * See i0(). * */ /* i0.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ #include "mconf.h" /* Chebyshev coefficients for md_exp(-x) I0(x) * in the interval [0,8]. * * lim(x->0){ md_exp(-x) I0(x) } = 1. */ #ifdef UNK static double A[] = { -4.41534164647933937950E-18, 3.33079451882223809783E-17, -2.43127984654795469359E-16, 1.71539128555513303061E-15, -1.16853328779934516808E-14, 7.67618549860493561688E-14, -4.85644678311192946090E-13, 2.95505266312963983461E-12, -1.72682629144155570723E-11, 9.67580903537323691224E-11, -5.18979560163526290666E-10, 2.65982372468238665035E-9, -1.30002500998624804212E-8, 6.04699502254191894932E-8, -2.67079385394061173391E-7, 1.11738753912010371815E-6, -4.41673835845875056359E-6, 1.64484480707288970893E-5, -5.75419501008210370398E-5, 1.88502885095841655729E-4, -5.76375574538582365885E-4, 1.63947561694133579842E-3, -4.32430999505057594430E-3, 1.05464603945949983183E-2, -2.37374148058994688156E-2, 4.93052842396707084878E-2, -9.49010970480476444210E-2, 1.71620901522208775349E-1, -3.04682672343198398683E-1, 6.76795274409476084995E-1 }; #endif #ifdef DEC static unsigned short A[] = { 0121642,0162671,0004646,0103567, 0022431,0115424,0135755,0026104, 0123214,0023533,0110365,0156635, 0023767,0033304,0117662,0172716, 0124522,0100426,0012277,0157531, 0025254,0155062,0054461,0030465, 0126010,0131143,0013560,0153604, 0026517,0170577,0006336,0114437, 0127227,0162253,0152243,0052734, 0027724,0142766,0061641,0160200, 0130416,0123760,0116564,0125262, 0031066,0144035,0021246,0054641, 0131537,0053664,0060131,0102530, 0032201,0155664,0165153,0020652, 0132617,0061434,0074423,0176145, 0033225,0174444,0136147,0122542, 0133624,0031576,0056453,0020470, 0034211,0175305,0172321,0041314, 0134561,0054462,0147040,0165315, 0035105,0124333,0120203,0162532, 0135427,0013750,0174257,0055221, 0035726,0161654,0050220,0100162, 0136215,0131361,0000325,0041110, 0036454,0145417,0117357,0017352, 0136702,0072367,0104415,0133574, 0037111,0172126,0072505,0014544, 0137302,0055601,0120550,0033523, 0037457,0136543,0136544,0043002, 0137633,0177536,0001276,0066150, 0040055,0041164,0100655,0010521 }; #endif #ifdef IBMPC static unsigned short A[] = { 0xd0ef,0x2134,0x5cb7,0xbc54, 0xa589,0x977d,0x3362,0x3c83, 0xbbb4,0x721e,0x84eb,0xbcb1, 0x5eba,0x93f6,0xe6d8,0x3cde, 0xfbeb,0xc297,0x5022,0xbd0a, 0x2627,0x4b26,0x9b46,0x3d35, 0x1af0,0x62ee,0x164c,0xbd61, 0xd324,0xe19b,0xfe2f,0x3d89, 0x6abc,0x7a94,0xfc95,0xbdb2, 0x3c10,0xcc74,0x98be,0x3dda, 0x9556,0x13ae,0xd4fe,0xbe01, 0xcb34,0xa454,0xd903,0x3e26, 0x30ab,0x8c0b,0xeaf6,0xbe4b, 0x6435,0x9d4d,0x3b76,0x3e70, 0x7f8d,0x8f22,0xec63,0xbe91, 0xf4ac,0x978c,0xbf24,0x3eb2, 0x6427,0xcba5,0x866f,0xbed2, 0x2859,0xbe9a,0x3f58,0x3ef1, 0x1d5a,0x59c4,0x2b26,0xbf0e, 0x7cab,0x7410,0xb51b,0x3f28, 0xeb52,0x1f15,0xe2fd,0xbf42, 0x100e,0x8a12,0xdc75,0x3f5a, 0xa849,0x201a,0xb65e,0xbf71, 0xe3dd,0xf3dd,0x9961,0x3f85, 0xb6f0,0xf121,0x4e9e,0xbf98, 0xa32d,0xcea8,0x3e8a,0x3fa9, 0x06ea,0x342d,0x4b70,0xbfb8, 0x88c0,0x77ac,0xf7ac,0x3fc5, 0xcd8d,0xc057,0x7feb,0xbfd3, 0xa22a,0x9035,0xa84e,0x3fe5, }; #endif #ifdef MIEEE static unsigned short A[] = { 0xbc54,0x5cb7,0x2134,0xd0ef, 0x3c83,0x3362,0x977d,0xa589, 0xbcb1,0x84eb,0x721e,0xbbb4, 0x3cde,0xe6d8,0x93f6,0x5eba, 0xbd0a,0x5022,0xc297,0xfbeb, 0x3d35,0x9b46,0x4b26,0x2627, 0xbd61,0x164c,0x62ee,0x1af0, 0x3d89,0xfe2f,0xe19b,0xd324, 0xbdb2,0xfc95,0x7a94,0x6abc, 0x3dda,0x98be,0xcc74,0x3c10, 0xbe01,0xd4fe,0x13ae,0x9556, 0x3e26,0xd903,0xa454,0xcb34, 0xbe4b,0xeaf6,0x8c0b,0x30ab, 0x3e70,0x3b76,0x9d4d,0x6435, 0xbe91,0xec63,0x8f22,0x7f8d, 0x3eb2,0xbf24,0x978c,0xf4ac, 0xbed2,0x866f,0xcba5,0x6427, 0x3ef1,0x3f58,0xbe9a,0x2859, 0xbf0e,0x2b26,0x59c4,0x1d5a, 0x3f28,0xb51b,0x7410,0x7cab, 0xbf42,0xe2fd,0x1f15,0xeb52, 0x3f5a,0xdc75,0x8a12,0x100e, 0xbf71,0xb65e,0x201a,0xa849, 0x3f85,0x9961,0xf3dd,0xe3dd, 0xbf98,0x4e9e,0xf121,0xb6f0, 0x3fa9,0x3e8a,0xcea8,0xa32d, 0xbfb8,0x4b70,0x342d,0x06ea, 0x3fc5,0xf7ac,0x77ac,0x88c0, 0xbfd3,0x7feb,0xc057,0xcd8d, 0x3fe5,0xa84e,0x9035,0xa22a }; #endif /* Chebyshev coefficients for md_exp(-x) sqrt(x) I0(x) * in the inverted interval [8,infinity]. * * lim(x->inf){ md_exp(-x) sqrt(x) I0(x) } = 1/sqrt(2pi). */ #ifdef UNK static double B[] = { -7.23318048787475395456E-18, -4.83050448594418207126E-18, 4.46562142029675999901E-17, 3.46122286769746109310E-17, -2.82762398051658348494E-16, -3.42548561967721913462E-16, 1.77256013305652638360E-15, 3.81168066935262242075E-15, -9.55484669882830764870E-15, -4.15056934728722208663E-14, 1.54008621752140982691E-14, 3.85277838274214270114E-13, 7.18012445138366623367E-13, -1.79417853150680611778E-12, -1.32158118404477131188E-11, -3.14991652796324136454E-11, 1.18891471078464383424E-11, 4.94060238822496958910E-10, 3.39623202570838634515E-9, 2.26666899049817806459E-8, 2.04891858946906374183E-7, 2.89137052083475648297E-6, 6.88975834691682398426E-5, 3.36911647825569408990E-3, 8.04490411014108831608E-1 }; #endif #ifdef DEC static unsigned short B[] = { 0122005,0066672,0123124,0054311, 0121662,0033323,0030214,0104602, 0022515,0170300,0113314,0020413, 0022437,0117350,0035402,0007146, 0123243,0000135,0057220,0177435, 0123305,0073476,0144106,0170702, 0023777,0071755,0017527,0154373, 0024211,0052214,0102247,0033270, 0124454,0017763,0171453,0012322, 0125072,0166316,0075505,0154616, 0024612,0133770,0065376,0025045, 0025730,0162143,0056036,0001632, 0026112,0015077,0150464,0063542, 0126374,0101030,0014274,0065457, 0127150,0077271,0125763,0157617, 0127412,0104350,0040713,0120445, 0027121,0023765,0057500,0001165, 0030407,0147146,0003643,0075644, 0031151,0061445,0044422,0156065, 0031702,0132224,0003266,0125551, 0032534,0000076,0147153,0005555, 0033502,0004536,0004016,0026055, 0034620,0076433,0142314,0171215, 0036134,0146145,0013454,0101104, 0040115,0171425,0062500,0047133 }; #endif #ifdef IBMPC static unsigned short B[] = { 0x8b19,0x54ca,0xadb7,0xbc60, 0x9130,0x6611,0x46da,0xbc56, 0x8421,0x12d9,0xbe18,0x3c89, 0x41cd,0x0760,0xf3dd,0x3c83, 0x1fe4,0xabd2,0x600b,0xbcb4, 0xde38,0xd908,0xaee7,0xbcb8, 0xfb1f,0xa3ea,0xee7d,0x3cdf, 0xe6d7,0x9094,0x2a91,0x3cf1, 0x629a,0x7e65,0x83fe,0xbd05, 0xbb32,0xcf68,0x5d99,0xbd27, 0xc545,0x0d5f,0x56ff,0x3d11, 0xc073,0x6b83,0x1c8c,0x3d5b, 0x8cec,0xfa26,0x4347,0x3d69, 0x8d66,0x0317,0x9043,0xbd7f, 0x7bf2,0x357e,0x0fd7,0xbdad, 0x7425,0x0839,0x511d,0xbdc1, 0x004f,0xabe8,0x24fe,0x3daa, 0x6f75,0xc0f4,0xf9cc,0x3e00, 0x5b87,0xa922,0x2c64,0x3e2d, 0xd56d,0x80d6,0x5692,0x3e58, 0x616e,0xd9cd,0x8007,0x3e8b, 0xc586,0xc101,0x412b,0x3ec8, 0x9e52,0x7899,0x0fa3,0x3f12, 0x9049,0xa2e5,0x998c,0x3f6b, 0x09cb,0xaca8,0xbe62,0x3fe9 }; #endif #ifdef MIEEE static unsigned short B[] = { 0xbc60,0xadb7,0x54ca,0x8b19, 0xbc56,0x46da,0x6611,0x9130, 0x3c89,0xbe18,0x12d9,0x8421, 0x3c83,0xf3dd,0x0760,0x41cd, 0xbcb4,0x600b,0xabd2,0x1fe4, 0xbcb8,0xaee7,0xd908,0xde38, 0x3cdf,0xee7d,0xa3ea,0xfb1f, 0x3cf1,0x2a91,0x9094,0xe6d7, 0xbd05,0x83fe,0x7e65,0x629a, 0xbd27,0x5d99,0xcf68,0xbb32, 0x3d11,0x56ff,0x0d5f,0xc545, 0x3d5b,0x1c8c,0x6b83,0xc073, 0x3d69,0x4347,0xfa26,0x8cec, 0xbd7f,0x9043,0x0317,0x8d66, 0xbdad,0x0fd7,0x357e,0x7bf2, 0xbdc1,0x511d,0x0839,0x7425, 0x3daa,0x24fe,0xabe8,0x004f, 0x3e00,0xf9cc,0xc0f4,0x6f75, 0x3e2d,0x2c64,0xa922,0x5b87, 0x3e58,0x5692,0x80d6,0xd56d, 0x3e8b,0x8007,0xd9cd,0x616e, 0x3ec8,0x412b,0xc101,0xc586, 0x3f12,0x0fa3,0x7899,0x9e52, 0x3f6b,0x998c,0xa2e5,0x9049, 0x3fe9,0xbe62,0xaca8,0x09cb }; #endif #ifdef ANSIPROT extern double chbevl ( double, void *, int ); extern double md_exp ( double ); extern double sqrt ( double ); #else double chbevl(), md_exp(), sqrt(); #endif double i0(x) double x; { double y; if( x < 0 ) x = -x; if( x <= 8.0 ) { y = (x/2.0) - 2.0; return( md_exp(x) * chbevl( y, A, 30 ) ); } return( md_exp(x) * chbevl( 32.0/x - 2.0, B, 25 ) / sqrt(x) ); } double i0e( x ) double x; { double y; if( x < 0 ) x = -x; if( x <= 8.0 ) { y = (x/2.0) - 2.0; return( chbevl( y, A, 30 ) ); } return( chbevl( 32.0/x - 2.0, B, 25 ) / sqrt(x) ); } Math-Cephes-0.5306/libmd/setprec.3870000644000175000017500000000213014757021403016567 0ustar shlomifshlomif/* Set 80387 floating point hardware rounding precision */ .file "setprec.387" .text .align 2 .globl _sprec _sprec: pushl %ebp movl %esp,%ebp pushl %eax subl $4,%esp fstcw (%esp) fwait movl (%esp),%eax andl $0xfcff,%eax movl %eax,(%esp) fldcw (%esp) popl %eax popl %eax leave ret .align 2 .globl _dprec _dprec: pushl %ebp movl %esp,%ebp pushl %eax subl $4,%esp fstcw (%esp) fwait movl (%esp),%eax /* andl $0xfcff,%eax */ /* exception on overflow */ andl $0xfcf7,%eax orl $0x200,%eax movl %eax,(%esp) fldcw (%esp) popl %eax popl %eax leave ret .align 2 .globl _ldprec _ldprec: pushl %ebp movl %esp,%ebp pushl %eax subl $4,%esp fstcw (%esp) fwait movl (%esp),%eax orl $0x300,%eax movl %eax,(%esp) fldcw (%esp) popl %eax popl %eax leave ret .globl _getprec _getprec: pushl %ebp movl %esp,%ebp subl $4,%esp fstcw (%esp) fwait movl (%esp),%eax leave ret .globl _setfpu _setfpu: pushl %ebp movl %esp,%ebp movl 8(%ebp),%eax pushl %eax fldcw (%esp) fwait movl %ebp,%esp popl %ebp ret Math-Cephes-0.5306/libmd/polrt.c0000644000175000017500000000700414757021403016170 0ustar shlomifshlomif/* polrt.c * * Find roots of a polynomial * * * * SYNOPSIS: * * typedef struct * { * double r; * double i; * }cmplx; * * double xcof[], cof[]; * int m; * cmplx root[]; * * polrt( xcof, cof, m, root ) * * * * DESCRIPTION: * * Iterative determination of the roots of a polynomial of * degree m whose coefficient vector is xcof[]. The * coefficients are arranged in ascending order; i.e., the * coefficient of x**m is xcof[m]. * * The array cof[] is working storage the same size as xcof[]. * root[] is the output array containing the complex roots. * * * ACCURACY: * * Termination depends on evaluation of the polynomial at * the trial values of the roots. The values of multiple roots * or of roots that are nearly equal may have poor relative * accuracy after the first root in the neighborhood has been * found. * */ /* polrt */ /* Complex roots of real polynomial */ /* number of coefficients is m + 1 ( i.e., m is degree of polynomial) */ #include "mconf.h" /* typedef struct { double r; double i; }cmplx; */ #ifdef ANSIPROT extern double md_fabs ( double ); #else double md_fabs(); #endif int polrt( xcof, cof, m, root ) double xcof[], cof[]; int m; cmplx root[]; { register double *p, *q; int i, j, nsav, n, n1, n2, nroot, iter, retry; int final; double mag, cofj; cmplx x0, x, xsav, dx, t, t1, u, ud; final = 0; n = m; if( n <= 0 ) return(1); if( n > 36 ) return(2); if( xcof[m] == 0.0 ) return(4); n1 = n; n2 = n; nroot = 0; nsav = n; q = &xcof[0]; p = &cof[n]; for( j=0; j<=nsav; j++ ) *p-- = *q++; /* cof[ n-j ] = xcof[j];*/ xsav.r = 0.0; xsav.i = 0.0; nxtrut: x0.r = 0.00500101; x0.i = 0.01000101; retry = 0; tryagn: retry += 1; x.r = x0.r; x0.r = -10.0 * x0.i; x0.i = -10.0 * x.r; x.r = x0.r; x.i = x0.i; finitr: iter = 0; while( iter < 500 ) { u.r = cof[n]; if( u.r == 0.0 ) { /* this root is zero */ x.r = 0; n1 -= 1; n2 -= 1; goto zerrut; } u.i = 0; ud.r = 0; ud.i = 0; t.r = 1.0; t.i = 0; p = &cof[n-1]; for( i=0; i= 1.0e-5 ) { cofj = x.r + x.r; mag = x.r * x.r + x.i * x.i; n -= 2; } else { /* root is real */ zerrut: x.i = 0; cofj = x.r; mag = 0; n -= 1; } /* divide working polynomial cof(z) by z - x */ p = &cof[1]; *p += cofj * *(p-1); for( j=1; j 0 ) goto nxtrut; return(0); } Math-Cephes-0.5306/libmd/eigens.c0000644000175000017500000000625414757021403016310 0ustar shlomifshlomif/* eigens.c * * Eigenvalues and eigenvectors of a real symmetric matrix * * * * SYNOPSIS: * * int n; * double A[n*(n+1)/2], EV[n*n], E[n]; * void eigens( A, EV, E, n ); * * * * DESCRIPTION: * * The algorithm is due to J. vonNeumann. * * A[] is a symmetric matrix stored in lower triangular form. * That is, A[ row, column ] = A[ (row*row+row)/2 + column ] * or equivalently with row and column interchanged. The * indices row and column run from 0 through n-1. * * EV[] is the output matrix of eigenvectors stored columnwise. * That is, the elements of each eigenvector appear in sequential * memory order. The jth element of the ith eigenvector is * EV[ n*i+j ] = EV[i][j]. * * E[] is the output matrix of eigenvalues. The ith element * of E corresponds to the ith eigenvector (the ith row of EV). * * On output, the matrix A will have been diagonalized and its * orginal contents are destroyed. * * ACCURACY: * * The error is controlled by an internal parameter called RANGE * which is set to 1e-10. After diagonalization, the * off-diagonal elements of A will have been reduced by * this factor. * * ERROR MESSAGES: * * None. * */ #include "mconf.h" #ifdef ANSIPROT extern double sqrt ( double ); extern double md_fabs ( double ); #else double sqrt(), md_fabs(); #endif void eigens( A, RR, E, N ) double A[], RR[], E[]; int N; { int IND, L, LL, LM, M, MM, MQ, I, J, IA, LQ; int IQ, IM, IL, NLI, NMI; double ANORM, ANORMX, AIA, THR, ALM, ALL, AMM, X, Y; double SINX, SINX2, COSX, COSX2, SINCS, AIL, AIM; double RLI, RMI; static double RANGE = 1.0e-10; /*3.0517578e-5;*/ /* Initialize identity matrix in RR[] */ for( J=0; J ANORMX ) { THR=THR/N; do { /* while IND != 0 */ IND = 0; for( L=0; L M) IM=M+IQ; else IM=I+MQ; if(I >= L) IL=L+IQ; else IL=I+LQ; AIL=A[IL]; AIM=A[IM]; X=AIL*COSX-AIM*SINX; A[IM]=AIL*SINX+AIM*COSX; A[IL]=X; } NLI = N*L + I; NMI = N*M + I; RLI = RR[ NLI ]; RMI = RR[ NMI ]; RR[NLI]=RLI*COSX-RMI*SINX; RR[NMI]=RLI*SINX+RMI*COSX; } X=2.0*ALM*SINCS; A[LL]=ALL*COSX2+AMM*SINX2-X; A[MM]=ALL*SINX2+AMM*COSX2+X; A[LM]=(ALL-AMM)*SINCS+ALM*(COSX2-SINX2); } /* for M=L+1 to N-1 */ } /* for L=0 to N-2 */ } while( IND != 0 ); } /* while THR > ANORMX */ done: ; /* Extract eigenvalues from the reduced matrix */ L=0; for( J=1; J<=N; J++ ) { L=L+J; E[J-1]=A[L-1]; } } Math-Cephes-0.5306/libmd/incbi.c0000644000175000017500000001207414757021403016117 0ustar shlomifshlomif/* incbi() * * Inverse of imcomplete beta integral * * * * SYNOPSIS: * * double a, b, x, y, incbi(); * * x = incbi( a, b, y ); * * * * DESCRIPTION: * * Given y, the function finds x such that * * incbet( a, b, x ) = y . * * The routine performs interval halving or Newton iterations to find the * root of incbet(a,b,x) - y = 0. * * * ACCURACY: * * Relative error: * x a,b * arithmetic domain domain # trials peak rms * IEEE 0,1 .5,10000 50000 5.8e-12 1.3e-13 * IEEE 0,1 .25,100 100000 1.8e-13 3.9e-15 * IEEE 0,1 0,5 50000 1.1e-12 5.5e-15 * VAX 0,1 .5,100 25000 3.5e-14 1.1e-15 * With a and b constrained to half-integer or integer values: * IEEE 0,1 .5,10000 50000 5.8e-12 1.1e-13 * IEEE 0,1 .5,100 100000 1.7e-14 7.9e-16 * With a = .5, b constrained to half-integer or integer values: * IEEE 0,1 .5,10000 10000 8.3e-11 1.0e-11 */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1996, 2000 by Stephen L. Moshier */ #include "mconf.h" extern double MACHEP, MAXNUM, MAXLOG, MINLOG; #ifdef ANSIPROT extern double ndtri ( double ); extern double md_exp ( double ); extern double md_fabs ( double ); extern double md_log ( double ); extern double sqrt ( double ); extern double lgam ( double ); extern double incbet ( double, double, double ); #else double ndtri(), md_exp(), md_fabs(), md_log(), sqrt(), lgam(), incbet(); #endif double incbi( aa, bb, yy0 ) double aa, bb, yy0; { double a, b, md_y0, d, y, x, x0, x1, lgm, yp, di, dithresh, yl, yh, xt; int i, rflg, dir, nflg; i = 0; if( yy0 <= 0 ) return(0.0); if( yy0 >= 1.0 ) return(1.0); x0 = 0.0; yl = 0.0; x1 = 1.0; yh = 1.0; nflg = 0; if( aa <= 1.0 || bb <= 1.0 ) { dithresh = 1.0e-6; rflg = 0; a = aa; b = bb; md_y0 = yy0; x = a/(a+b); y = incbet( a, b, x ); goto ihalve; } else { dithresh = 1.0e-4; } /* approximation to inverse function */ yp = -ndtri(yy0); if( yy0 > 0.5 ) { rflg = 1; a = bb; b = aa; md_y0 = 1.0 - yy0; yp = -yp; } else { rflg = 0; a = aa; b = bb; md_y0 = yy0; } lgm = (yp * yp - 3.0)/6.0; x = 2.0/( 1.0/(2.0*a-1.0) + 1.0/(2.0*b-1.0) ); d = yp * sqrt( x + lgm ) / x - ( 1.0/(2.0*b-1.0) - 1.0/(2.0*a-1.0) ) * (lgm + 5.0/6.0 - 2.0/(3.0*x)); d = 2.0 * d; if( d < MINLOG ) { x = 1.0; goto under; } x = a/( a + b * md_exp(d) ); y = incbet( a, b, x ); yp = (y - md_y0)/md_y0; if( md_fabs(yp) < 0.2 ) goto newt; /* Resort to interval halving if not close enough. */ ihalve: dir = 0; di = 0.5; for( i=0; i<100; i++ ) { if( i != 0 ) { x = x0 + di * (x1 - x0); if( x == 1.0 ) x = 1.0 - MACHEP; if( x == 0.0 ) { di = 0.5; x = x0 + di * (x1 - x0); if( x == 0.0 ) goto under; } y = incbet( a, b, x ); yp = (x1 - x0)/(x1 + x0); if( md_fabs(yp) < dithresh ) goto newt; yp = (y-md_y0)/md_y0; if( md_fabs(yp) < dithresh ) goto newt; } if( y < md_y0 ) { x0 = x; yl = y; if( dir < 0 ) { dir = 0; di = 0.5; } else if( dir > 3 ) di = 1.0 - (1.0 - di) * (1.0 - di); else if( dir > 1 ) di = 0.5 * di + 0.5; else di = (md_y0 - y)/(yh - yl); dir += 1; if( x0 > 0.75 ) { if( rflg == 1 ) { rflg = 0; a = aa; b = bb; md_y0 = yy0; } else { rflg = 1; a = bb; b = aa; md_y0 = 1.0 - yy0; } x = 1.0 - x; y = incbet( a, b, x ); x0 = 0.0; yl = 0.0; x1 = 1.0; yh = 1.0; goto ihalve; } } else { x1 = x; if( rflg == 1 && x1 < MACHEP ) { x = 0.0; goto done; } yh = y; if( dir > 0 ) { dir = 0; di = 0.5; } else if( dir < -3 ) di = di * di; else if( dir < -1 ) di = 0.5 * di; else di = (y - md_y0)/(yh - yl); dir -= 1; } } mtherr( "incbi", PLOSS ); if( x0 >= 1.0 ) { x = 1.0 - MACHEP; goto done; } if( x <= 0.0 ) { under: mtherr( "incbi", UNDERFLOW ); x = 0.0; goto done; } newt: if( nflg ) goto done; nflg = 1; lgm = lgam(a+b) - lgam(a) - lgam(b); for( i=0; i<8; i++ ) { /* Compute the function at this point. */ if( i != 0 ) y = incbet(a,b,x); if( y < yl ) { x = x0; y = yl; } else if( y > yh ) { x = x1; y = yh; } else if( y < md_y0 ) { x0 = x; yl = y; } else { x1 = x; yh = y; } if( x == 1.0 || x == 0.0 ) break; /* Compute the derivative of the function at this point. */ d = (a - 1.0) * md_log(x) + (b - 1.0) * md_log(1.0-x) + lgm; if( d < MINLOG ) goto done; if( d > MAXLOG ) break; d = md_exp(d); /* Compute the step to the next approximation of x. */ d = (y - md_y0)/d; xt = x - d; if( xt <= x0 ) { y = (x - x0) / (x1 - x0); xt = x0 + 0.5 * y * (x - x0); if( xt <= 0.0 ) break; } if( xt >= x1 ) { y = (x1 - x) / (x1 - x0); xt = x1 - 0.5 * y * (x1 - x); if( xt >= 1.0 ) break; } x = xt; if( md_fabs(d/x) < 128.0 * MACHEP ) goto done; } /* Did not converge. */ dithresh = 256.0 * MACHEP; goto ihalve; done: if( rflg ) { if( x <= MACHEP ) x = 1.0 - MACHEP; else x = 1.0 - x; } return( x ); } Math-Cephes-0.5306/libmd/round.c0000644000175000017500000000210714757021403016156 0ustar shlomifshlomif/* md_round.c * * Round double to nearest or even integer valued double * * * * SYNOPSIS: * * double x, y, md_round(); * * y = md_round(x); * * * * DESCRIPTION: * * Returns the nearest integer to x as a double precision * floating point result. If x ends in 0.5 exactly, the * nearest even integer is chosen. * * * * ACCURACY: * * If x is greater than 1/(2*MACHEP), its closest machine * representation is already an integer, so rounding does * not change it. */ /* Cephes Math Library Release 2.1: January, 1989 Copyright 1984, 1987, 1989 by Stephen L. Moshier Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */ #include "mconf.h" #ifdef ANSIPROT double md_floor ( double ); #else double md_floor(); #endif double md_round(x) double x; { double y, r; /* Largest integer <= x */ y = md_floor(x); /* Fractional part */ r = x - y; /* Round up to nearest. */ if( r > 0.5 ) goto rndup; /* Round to even */ if( r == 0.5 ) { r = y - 2.0 * md_floor( 0.5 * y ); if( r == 1.0 ) { rndup: y += 1.0; } } /* Else md_round down. */ return(y); } Math-Cephes-0.5306/libmd/ellpe.c0000644000175000017500000001036714757021403016137 0ustar shlomifshlomif/* ellpe.c * * Complete elliptic integral of the second kind * * * * SYNOPSIS: * * double m1, y, ellpe(); * * y = ellpe( m1 ); * * * * DESCRIPTION: * * Approximates the integral * * * pi/2 * - * | | 2 * E(m) = | sqrt( 1 - m md_sin t ) dt * | | * - * 0 * * Where m = 1 - m1, using the approximation * * P(x) - x md_log x Q(x). * * Though there are no singularities, the argument m1 is used * rather than m for compatibility with ellpk(). * * E(1) = 1; E(0) = pi/2. * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC 0, 1 13000 3.1e-17 9.4e-18 * IEEE 0, 1 10000 2.1e-16 7.3e-17 * * * ERROR MESSAGES: * * message condition value returned * ellpe domain x<0, x>1 0.0 * */ /* ellpe.c */ /* Elliptic integral of second kind */ /* Cephes Math Library, Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef UNK static double P[] = { 1.53552577301013293365E-4, 2.50888492163602060990E-3, 8.68786816565889628429E-3, 1.07350949056076193403E-2, 7.77395492516787092951E-3, 7.58395289413514708519E-3, 1.15688436810574127319E-2, 2.18317996015557253103E-2, 5.68051945617860553470E-2, 4.43147180560990850618E-1, 1.00000000000000000299E0 }; static double Q[] = { 3.27954898576485872656E-5, 1.00962792679356715133E-3, 6.50609489976927491433E-3, 1.68862163993311317300E-2, 2.61769742454493659583E-2, 3.34833904888224918614E-2, 4.27180926518931511717E-2, 5.85936634471101055642E-2, 9.37499997197644278445E-2, 2.49999999999888314361E-1 }; #endif #ifdef DEC static unsigned short P[] = { 0035041,0001364,0141572,0117555, 0036044,0066032,0130027,0033404, 0036416,0053617,0064456,0102632, 0036457,0161100,0061177,0122612, 0036376,0136251,0012403,0124162, 0036370,0101316,0151715,0131613, 0036475,0105477,0050317,0133272, 0036662,0154232,0024645,0171552, 0037150,0126220,0047054,0030064, 0037742,0162057,0167645,0165612, 0040200,0000000,0000000,0000000 }; static unsigned short Q[] = { 0034411,0106743,0115771,0055462, 0035604,0052575,0155171,0045540, 0036325,0030424,0064332,0167756, 0036612,0052366,0063006,0115175, 0036726,0070430,0004533,0124654, 0037011,0022741,0030675,0030711, 0037056,0174452,0127062,0132122, 0037157,0177750,0142041,0072523, 0037277,0177777,0173137,0002627, 0037577,0177777,0177777,0101101 }; #endif #ifdef IBMPC static unsigned short P[] = { 0x53ee,0x986f,0x205e,0x3f24, 0xe6e0,0x5602,0x8d83,0x3f64, 0xd0b3,0xed25,0xcaf1,0x3f81, 0xf4b1,0x0c4f,0xfc48,0x3f85, 0x750e,0x22a0,0xd795,0x3f7f, 0xb671,0xda79,0x1059,0x3f7f, 0xf6d7,0xea19,0xb167,0x3f87, 0xbe6d,0x4534,0x5b13,0x3f96, 0x8607,0x09c5,0x1592,0x3fad, 0xbd71,0xfdf4,0x5c85,0x3fdc, 0x0000,0x0000,0x0000,0x3ff0 }; static unsigned short Q[] = { 0x2b66,0x737f,0x31bc,0x3f01, 0x296c,0xbb4f,0x8aaf,0x3f50, 0x5dfe,0x8d1b,0xa622,0x3f7a, 0xd350,0xccc0,0x4a9e,0x3f91, 0x7535,0x012b,0xce23,0x3f9a, 0xa639,0x2637,0x24bc,0x3fa1, 0x568a,0x55c6,0xdf25,0x3fa5, 0x2eaa,0x1884,0xfffd,0x3fad, 0xe0b3,0xfecb,0xffff,0x3fb7, 0xf048,0xffff,0xffff,0x3fcf }; #endif #ifdef MIEEE static unsigned short P[] = { 0x3f24,0x205e,0x986f,0x53ee, 0x3f64,0x8d83,0x5602,0xe6e0, 0x3f81,0xcaf1,0xed25,0xd0b3, 0x3f85,0xfc48,0x0c4f,0xf4b1, 0x3f7f,0xd795,0x22a0,0x750e, 0x3f7f,0x1059,0xda79,0xb671, 0x3f87,0xb167,0xea19,0xf6d7, 0x3f96,0x5b13,0x4534,0xbe6d, 0x3fad,0x1592,0x09c5,0x8607, 0x3fdc,0x5c85,0xfdf4,0xbd71, 0x3ff0,0x0000,0x0000,0x0000 }; static unsigned short Q[] = { 0x3f01,0x31bc,0x737f,0x2b66, 0x3f50,0x8aaf,0xbb4f,0x296c, 0x3f7a,0xa622,0x8d1b,0x5dfe, 0x3f91,0x4a9e,0xccc0,0xd350, 0x3f9a,0xce23,0x012b,0x7535, 0x3fa1,0x24bc,0x2637,0xa639, 0x3fa5,0xdf25,0x55c6,0x568a, 0x3fad,0xfffd,0x1884,0x2eaa, 0x3fb7,0xffff,0xfecb,0xe0b3, 0x3fcf,0xffff,0xffff,0xf048 }; #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double md_log ( double ); #else double polevl(), md_log(); #endif double ellpe(x) double x; { if( (x <= 0.0) || (x > 1.0) ) { if( x == 0.0 ) return( 1.0 ); mtherr( "ellpe", DOMAIN ); return( 0.0 ); } return( polevl(x,P,10) - md_log(x) * (x * polevl(x,Q,9)) ); } Math-Cephes-0.5306/libmd/atan.c0000644000175000017500000001476714757021403015771 0ustar shlomifshlomif/* md_atan.c * * Inverse circular tangent * (arctangent) * * * * SYNOPSIS: * * double x, y, md_atan(); * * y = md_atan( x ); * * * * DESCRIPTION: * * Returns radian angle between -pi/2 and +pi/2 whose tangent * is x. * * Range reduction is from three intervals into the interval * from zero to 0.66. The approximant uses a rational * function of degree 4/5 of the form x + x**3 P(x)/Q(x). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * DEC -10, 10 50000 2.4e-17 8.3e-18 * IEEE -10, 10 10^6 1.8e-16 5.0e-17 * */ /* md_atan2() * * Quadrant correct inverse circular tangent * * * * SYNOPSIS: * * double x, y, z, md_atan2(); * * z = md_atan2( y, x ); * * * * DESCRIPTION: * * Returns radian angle whose tangent is y/x. * Define compile time symbol ANSIC = 1 for ANSI standard, * range -PI < z <= +PI, args (y,x); else ANSIC = 0 for range * 0 to 2PI, args (x,y). * * * * ACCURACY: * * Relative error: * arithmetic domain # trials peak rms * IEEE -10, 10 10^6 2.5e-16 6.9e-17 * See md_atan.c. * */ /* md_atan.c */ /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" /* arctan(x) = x + x^3 P(x^2)/Q(x^2) 0 <= x <= 0.66 Peak relative error = 2.6e-18 */ #ifdef UNK static double P[5] = { -8.750608600031904122785E-1, -1.615753718733365076637E1, -7.500855792314704667340E1, -1.228866684490136173410E2, -6.485021904942025371773E1, }; static double Q[5] = { /* 1.000000000000000000000E0, */ 2.485846490142306297962E1, 1.650270098316988542046E2, 4.328810604912902668951E2, 4.853903996359136964868E2, 1.945506571482613964425E2, }; /* md_tan( 3*pi/8 ) */ static double T3P8 = 2.41421356237309504880; #endif #ifdef DEC static short P[20] = { 0140140,0001775,0007671,0026242, 0141201,0041242,0155534,0001715, 0141626,0002141,0132100,0011625, 0141765,0142771,0064055,0150453, 0141601,0131517,0164507,0062164, }; static short Q[20] = { /* 0040200,0000000,0000000,0000000, */ 0041306,0157042,0154243,0000742, 0042045,0003352,0016707,0150452, 0042330,0070306,0113425,0170730, 0042362,0130770,0116602,0047520, 0042102,0106367,0156753,0013541, }; /* md_tan( 3*pi/8 ) = 2.41421356237309504880 */ static unsigned short T3P8A[] = {040432,0101171,0114774,0167462,}; #define T3P8 *(double *)T3P8A #endif #ifdef IBMPC static short P[20] = { 0x2594,0xa1f7,0x007f,0xbfec, 0x807a,0x5b6b,0x2854,0xc030, 0x0273,0x3688,0xc08c,0xc052, 0xba25,0x2d05,0xb8bf,0xc05e, 0xec8e,0xfd28,0x3669,0xc050, }; static short Q[20] = { /* 0x0000,0x0000,0x0000,0x3ff0, */ 0x603c,0x5b14,0xdbc4,0x4038, 0xfa25,0x43b8,0xa0dd,0x4064, 0xbe3b,0xd2e2,0x0e18,0x407b, 0x49ea,0x13b0,0x563f,0x407e, 0x62ec,0xfbbd,0x519e,0x4068, }; /* md_tan( 3*pi/8 ) = 2.41421356237309504880 */ static unsigned short T3P8A[] = {0x9de6,0x333f,0x504f,0x4003}; #define T3P8 *(double *)T3P8A #endif #ifdef MIEEE static short P[20] = { 0xbfec,0x007f,0xa1f7,0x2594, 0xc030,0x2854,0x5b6b,0x807a, 0xc052,0xc08c,0x3688,0x0273, 0xc05e,0xb8bf,0x2d05,0xba25, 0xc050,0x3669,0xfd28,0xec8e, }; static short Q[20] = { /* 0x3ff0,0x0000,0x0000,0x0000, */ 0x4038,0xdbc4,0x5b14,0x603c, 0x4064,0xa0dd,0x43b8,0xfa25, 0x407b,0x0e18,0xd2e2,0xbe3b, 0x407e,0x563f,0x13b0,0x49ea, 0x4068,0x519e,0xfbbd,0x62ec, }; /* md_tan( 3*pi/8 ) = 2.41421356237309504880 */ static unsigned short T3P8A[] = { 0x4003,0x504f,0x333f,0x9de6 }; #define T3P8 *(double *)T3P8A #endif #ifdef ANSIPROT extern double polevl ( double, void *, int ); extern double p1evl ( double, void *, int ); extern double md_atan ( double ); extern double md_fabs ( double ); extern int signbit ( double ); extern int isnan ( double ); #else double polevl(), p1evl(), md_atan(), md_fabs(); int signbit(), isnan(); #endif extern double PI, PIO2, PIO4, INFINITY, NEGZERO, MAXNUM; /* pi/2 = PIO2 + MOREBITS. */ #ifdef DEC #define MOREBITS 5.721188726109831840122E-18 #else #define MOREBITS 6.123233995736765886130E-17 #endif double md_atan(x) double x; { double y, z; short sign, flag; #ifdef MINUSZERO if( x == 0.0 ) return(x); #endif #ifdef INFINITIES if(x == INFINITY) return(PIO2); if(x == -INFINITY) return(-PIO2); #endif /* make argument positive and save the sign */ sign = 1; if( x < 0.0 ) { sign = -1; x = -x; } /* range reduction */ flag = 0; if( x > T3P8 ) { y = PIO2; flag = 1; x = -( 1.0/x ); } else if( x <= 0.66 ) { y = 0.0; } else { y = PIO4; flag = 2; x = (x-1.0)/(x+1.0); } z = x * x; z = z * polevl( z, P, 4 ) / p1evl( z, Q, 5 ); z = x * z + x; if( flag == 2 ) z += 0.5 * MOREBITS; else if( flag == 1 ) z += MOREBITS; y = y + z; if( sign < 0 ) y = -y; return(y); } /* md_atan2 */ #ifdef ANSIC double md_atan2( y, x ) #else double md_atan2( x, y ) #endif double x, y; { double z, w; short code; code = 0; #ifdef NANS if( isnan(x) ) return(x); if( isnan(y) ) return(y); #endif #ifdef MINUSZERO if( y == 0.0 ) { if( signbit(y) ) { if( x > 0.0 ) z = y; else if( x < 0.0 ) z = -PI; else { if( signbit(x) ) z = -PI; else z = y; } } else /* y is +0 */ { if( x == 0.0 ) { if( signbit(x) ) z = PI; else z = 0.0; } else if( x > 0.0 ) z = 0.0; else z = PI; } return z; } if( x == 0.0 ) { if( y > 0.0 ) z = PIO2; else z = -PIO2; return z; } #endif /* MINUSZERO */ #ifdef INFINITIES if( x == INFINITY ) { if( y == INFINITY ) z = 0.25 * PI; else if( y == -INFINITY ) z = -0.25 * PI; else if( y < 0.0 ) z = NEGZERO; else z = 0.0; return z; } if( x == -INFINITY ) { if( y == INFINITY ) z = 0.75 * PI; else if( y <= -INFINITY ) z = -0.75 * PI; else if( y >= 0.0 ) z = PI; else z = -PI; return z; } if( y == INFINITY ) return( PIO2 ); if( y == -INFINITY ) return( -PIO2 ); #endif if( x < 0.0 ) code = 2; if( y < 0.0 ) code |= 1; #ifdef INFINITIES if( x == 0.0 ) #else if( md_fabs(x) <= (md_fabs(y) / MAXNUM) ) #endif { if( code & 1 ) { #if ANSIC return( -PIO2 ); #else return( 3.0*PIO2 ); #endif } if( y == 0.0 ) return( 0.0 ); return( PIO2 ); } if( y == 0.0 ) { if( code & 2 ) return( PI ); return( 0.0 ); } switch( code ) { #if ANSIC default: case 0: case 1: w = 0.0; break; case 2: w = PI; break; case 3: w = -PI; break; #else default: case 0: w = 0.0; break; case 1: w = 2.0 * PI; break; case 2: case 3: w = PI; break; #endif } z = w + md_atan( y/x ); #ifdef MINUSZERO if( z == 0.0 && y < 0 ) z = NEGZERO; #endif return( z ); } Math-Cephes-0.5306/.gitignore0000644000175000017500000000022414757021403015562 0ustar shlomifshlomifCephes.bs Cephes_wrap.o MYMETA.json MYMETA.yml Makefile arrays.o blib libmd/*.o libmd/libmd.a libmd/mconf.h libmd/setprec.c libmd/sqrt.c pm_to_blib Math-Cephes-0.5306/lib/0000755000175000017500000000000014757250372014353 5ustar shlomifshlomifMath-Cephes-0.5306/lib/Math/0000755000175000017500000000000014757250372015244 5ustar shlomifshlomifMath-Cephes-0.5306/lib/Math/Cephes.pod0000644000175000017500000034657614757021403017173 0ustar shlomifshlomif=head1 NAME Math::Cephes - perl interface to the cephes math library =head1 SYNOPSIS use Math::Cephes qw(:all); =head1 DESCRIPTION This module provides an interface to over 150 functions of the cephes math library of Stephen Moshier. No functions are exported by default, but rather must be imported explicitly, as in use Math::Cephes qw(sin cos); There are a number of export tags defined which allow importing groups of functions: =over 4 =item use Math::Cephes qw(:constants); imports the variables $PI : 3.14159265358979323846 # pi $PIO2 : 1.57079632679489661923 # pi/2 $PIO4 : 0.785398163397448309616 # pi/4 $SQRT2 : 1.41421356237309504880 # sqrt(2) $SQRTH : 0.707106781186547524401 # sqrt(2)/2 $LOG2E : 1.4426950408889634073599 # 1/log(2) $SQ2OPI : 0.79788456080286535587989 # sqrt( 2/pi ) $LOGE2 : 0.693147180559945309417 # log(2) $LOGSQ2 : 0.346573590279972654709 # log(2)/2 $THPIO4 : 2.35619449019234492885 # 3*pi/4 $TWOOPI : 0.636619772367581343075535 # 2/pi As well, there are 4 machine-specific numbers available: $MACHEP : machine roundoff error $MAXLOG : maximum log on the machine $MINLOG : minimum log on the machine $MAXNUM : largest number represented =item use Math::Cephes qw(:trigs); imports acos: Inverse circular cosine asin: Inverse circular sine atan: Inverse circular tangent (arctangent) atan2: Quadrant correct inverse circular tangent cos: Circular cosine cosdg: Circular cosine of angle in degrees cot: Circular cotangent cotdg: Circular cotangent of argument in degrees hypot: hypotenuse associated with the sides of a right triangle radian: Degrees, minutes, seconds to radians sin: Circular sine sindg: Circular sine of angle in degrees tan: Circular tangent tandg: Circular tangent of argument in degrees cosm1: Relative error approximations for function arguments near unity =item use Math::Cephes qw(:hypers); imports acosh: Inverse hyperbolic cosine asinh: Inverse hyperbolic sine atanh: Inverse hyperbolic tangent cosh: Hyperbolic cosine sinh: Hyperbolic sine tanh: Hyperbolic tangent =item use Math::Cephes qw(:explog); imports exp: Exponential function expxx: exp(x*x) exp10: Base 10 exponential function (Common antilogarithm) exp2: Base 2 exponential function log: Natural logarithm log10: Common logarithm log2: Base 2 logarithm log1p,expm1: Relative error approximations for function arguments near unity. =item use Math::Cephes qw(:cmplx); imports new_cmplx: create a new complex number object cabs: Complex absolute value cacos: Complex circular arc cosine cacosh: Complex inverse hyperbolic cosine casin: Complex circular arc sine casinh: Complex inverse hyperbolic sine catan: Complex circular arc tangent catanh: Complex inverse hyperbolic tangent ccos: Complex circular cosine ccosh: Complex hyperbolic cosine ccot: Complex circular cotangent cexp: Complex exponential function clog: Complex natural logarithm cadd: add two complex numbers csub: subtract two complex numbers cmul: multiply two complex numbers cdiv: divide two complex numbers cmov: copy one complex number to another cneg: negate a complex number cpow: Complex power function csin: Complex circular sine csinh: Complex hyperbolic sine csqrt: Complex square root ctan: Complex circular tangent ctanh: Complex hyperbolic tangent =item use Math::Cephes qw(:utils); imports cbrt: Cube root ceil: ceil drand: Pseudorandom number generator fabs: Absolute value fac: Factorial function floor: floor frexp: frexp ldexp: multiplies x by 2**n. lrand: Pseudorandom number generator lsqrt: Integer square root pow: Power function powi: Real raised to integer power round: Round double to nearest or even integer valued double sqrt: Square root =item use Math::Cephes qw(:bessels); imports i0: Modified Bessel function of order zero i0e: Modified Bessel function of order zero, exponentially scaled i1: Modified Bessel function of order one i1e: Modified Bessel function of order one, exponentially scaled iv: Modified Bessel function of noninteger order j0: Bessel function of order zero j1: Bessel function of order one jn: Bessel function of integer order jv: Bessel function of noninteger order k0: Modified Bessel function, third kind, order zero k0e: Modified Bessel function, third kind, order zero, exponentially scaled k1: Modified Bessel function, third kind, order one k1e: Modified Bessel function, third kind, order one, exponentially scaled kn: Modified Bessel function, third kind, integer order y0: Bessel function of the second kind, order zero y1: Bessel function of second kind of order one yn: Bessel function of second kind of integer order yv: Bessel function Yv with noninteger v =item use Math::Cephes qw(:dists); imports bdtr: Binomial distribution bdtrc: Complemented binomial distribution bdtri: Inverse binomial distribution btdtr: Beta distribution chdtr: Chi-square distribution chdtrc: Complemented Chi-square distribution chdtri: Inverse of complemented Chi-square distribution fdtr: F distribution fdtrc: Complemented F distribution fdtri: Inverse of complemented F distribution gdtr: Gamma distribution function gdtrc: Complemented gamma distribution function nbdtr: Negative binomial distribution nbdtrc: Complemented negative binomial distribution nbdtri: Functional inverse of negative binomial distribution ndtr: Normal distribution function ndtri: Inverse of Normal distribution function pdtr: Poisson distribution pdtrc: Complemented poisson distribution pdtri: Inverse Poisson distribution stdtr: Student's t distribution stdtri: Functional inverse of Student's t distribution =item use Math::Cephes qw(:gammas); imports fac: Factorial function gamma: Gamma function igam: Incomplete gamma integral igamc: Complemented incomplete gamma integral igami: Inverse of complemented imcomplete gamma integral psi: Psi (digamma) function rgamma: Reciprocal gamma function =item use Math::Cephes qw(:betas); imports beta: Beta function incbet: Incomplete beta integral incbi: Inverse of imcomplete beta integral lbeta: Natural logarithm of |beta| =item use Math::Cephes qw(:elliptics); imports ellie: Incomplete elliptic integral of the second kind ellik: Incomplete elliptic integral of the first kind ellpe: Complete elliptic integral of the second kind ellpj: Jacobian Elliptic Functions ellpk: Complete elliptic integral of the first kind =item use Math::Cephes qw(:hypergeometrics); imports hyp2f0: Gauss hypergeometric function F hyp2f1: Gauss hypergeometric function F hyperg: Confluent hypergeometric function onef2: Hypergeometric function 1F2 threef0: Hypergeometric function 3F0 =item use Math::Cephes qw(:misc); imports airy: Airy function bernum: Bernoulli numbers dawsn: Dawson's Integral ei: Exponential integral erf: Error function erfc: Complementary error function expn: Exponential integral En fresnl: Fresnel integral plancki: Integral of Planck's black body radiation formula polylog: Polylogarithm function shichi: Hyperbolic sine and cosine integrals sici: Sine and cosine integrals simpson: Simpson's rule to find an integral spence: Dilogarithm struve: Struve function vecang: angle between two vectors zeta: Riemann zeta function of two arguments zetac: Riemann zeta function =item use Math::Cephes qw(:fract); imports new_fract: create a new fraction object radd: add two fractions rmul: multiply two fractions rsub: subtracttwo fractions rdiv: divide two fractions euclid: finds the greatest common divisor =back =head1 FUNCTIONS A description of the various functions available follows. =over 4 =item I: Inverse hyperbolic cosine SYNOPSIS: # double x, y, acosh(); $y = acosh( $x ); DESCRIPTION: Returns inverse hyperbolic cosine of argument. If 1 <= x < 1.5, a rational approximation sqrt(z) * P(z)/Q(z) where z = x-1, is used. Otherwise, acosh(x) = log( x + sqrt( (x-1)(x+1) ). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 1,3 30000 4.2e-17 1.1e-17 IEEE 1,3 30000 4.6e-16 8.7e-17 ERROR MESSAGES: message condition value returned acosh domain |x| < 1 NAN =item I: Airy function SYNOPSIS: # double x, ai, aiprime, bi, biprime; # int airy(); ($flag, $ai, $aiprime, $bi, $biprime) = airy( $x ); DESCRIPTION: Solution of the differential equation y"(x) = xy. The function returns the two independent solutions Ai, Bi and their first derivatives Ai'(x), Bi'(x). Evaluation is by power series summation for small x, by rational minimax approximations for large x. ACCURACY: Error criterion is absolute when function <= 1, relative when function > 1, except * denotes relative error criterion. For large negative x, the absolute error increases as x^1.5. For large positive x, the relative error increases as x^1.5. Arithmetic domain function # trials peak rms IEEE -10, 0 Ai 10000 1.6e-15 2.7e-16 IEEE 0, 10 Ai 10000 2.3e-14* 1.8e-15* IEEE -10, 0 Ai' 10000 4.6e-15 7.6e-16 IEEE 0, 10 Ai' 10000 1.8e-14* 1.5e-15* IEEE -10, 10 Bi 30000 4.2e-15 5.3e-16 IEEE -10, 10 Bi' 30000 4.9e-15 7.3e-16 DEC -10, 0 Ai 5000 1.7e-16 2.8e-17 DEC 0, 10 Ai 5000 2.1e-15* 1.7e-16* DEC -10, 0 Ai' 5000 4.7e-16 7.8e-17 DEC 0, 10 Ai' 12000 1.8e-15* 1.5e-16* DEC -10, 10 Bi 10000 5.5e-16 6.8e-17 DEC -10, 10 Bi' 7000 5.3e-16 8.7e-17 =item I: Degrees, minutes, seconds to radians SYNOPSIS: # double d, m, s, radian(); $r = radian( $d, $m, $s ); DESCRIPTION: Converts an angle of degrees, minutes, seconds to radians. =item I: returns the hypotenuse associated with the sides of a right triangle SYNOPSIS: # double a, b, c, hypot(); $c = hypot( $a, $b ); DESCRIPTION: Calculates the hypotenuse associated with the sides of a right triangle, according to c = sqrt( a**2 + b**2) =item I: Inverse circular sine SYNOPSIS: # double x, y, asin(); $y = asin( $x ); DESCRIPTION: Returns radian angle between -pi/2 and +pi/2 whose sine is x. A rational function of the form x + x**3 P(x**2)/Q(x**2) is used for |x| in the interval [0, 0.5]. If |x| > 0.5 it is transformed by the identity asin(x) = pi/2 - 2 asin( sqrt( (1-x)/2 ) ). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -1, 1 40000 2.6e-17 7.1e-18 IEEE -1, 1 10^6 1.9e-16 5.4e-17 ERROR MESSAGES: message condition value returned asin domain |x| > 1 NAN =item I: Inverse circular cosine SYNOPSIS: # double x, y, acos(); $y = acos( $x ); DESCRIPTION: Returns radian angle between 0 and pi whose cosine is x. Analytically, acos(x) = pi/2 - asin(x). However if |x| is near 1, there is cancellation error in subtracting asin(x) from pi/2. Hence if x < -0.5, acos(x) = pi - 2.0 * asin( sqrt((1+x)/2) ); or if x > +0.5, acos(x) = 2.0 * asin( sqrt((1-x)/2) ). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -1, 1 50000 3.3e-17 8.2e-18 IEEE -1, 1 10^6 2.2e-16 6.5e-17 ERROR MESSAGES: message condition value returned asin domain |x| > 1 NAN =item I: Inverse hyperbolic sine SYNOPSIS: # double x, y, asinh(); $y = asinh( $x ); DESCRIPTION: Returns inverse hyperbolic sine of argument. If |x| < 0.5, the function is approximated by a rational form x + x**3 P(x)/Q(x). Otherwise, asinh(x) = log( x + sqrt(1 + x*x) ). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -3,3 75000 4.6e-17 1.1e-17 IEEE -1,1 30000 3.7e-16 7.8e-17 IEEE 1,3 30000 2.5e-16 6.7e-17 =item I: Inverse circular tangent (arctangent) SYNOPSIS: # double x, y, atan(); $y = atan( $x ); DESCRIPTION: Returns radian angle between -pi/2 and +pi/2 whose tangent is x. Range reduction is from three intervals into the interval from zero to 0.66. The approximant uses a rational function of degree 4/5 of the form x + x**3 P(x)/Q(x). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -10, 10 50000 2.4e-17 8.3e-18 IEEE -10, 10 10^6 1.8e-16 5.0e-17 =item I: Quadrant correct inverse circular tangent SYNOPSIS: # double x, y, z, atan2(); $z = atan2( $y, $x ); DESCRIPTION: Returns radian angle whose tangent is y/x. Define compile time symbol ANSIC = 1 for ANSI standard, range -PI < z <= +PI, args (y,x); else ANSIC = 0 for range 0 to 2PI, args (x,y). ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -10, 10 10^6 2.5e-16 6.9e-17 See atan.c. =item I: Inverse hyperbolic tangent SYNOPSIS: # double x, y, atanh(); $y = atanh( $x ); DESCRIPTION: Returns inverse hyperbolic tangent of argument in the range MINLOG to MAXLOG. If |x| < 0.5, the rational form x + x**3 P(x)/Q(x) is employed. Otherwise, atanh(x) = 0.5 * log( (1+x)/(1-x) ). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -1,1 50000 2.4e-17 6.4e-18 IEEE -1,1 30000 1.9e-16 5.2e-17 =item I: Binomial distribution SYNOPSIS: # int k, n; # double p, y, bdtr(); $y = bdtr( $k, $n, $p ); DESCRIPTION: Returns the sum of the terms 0 through k of the Binomial probability density: k -- ( n ) j n-j > ( ) p (1-p) -- ( j ) j=0 The terms are not summed directly; instead the incomplete beta integral is employed, according to the formula y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ). The arguments must be positive, with p ranging from 0 to 1. ACCURACY: Tested at random points (a,b,p), with p between 0 and 1. a,b Relative error: arithmetic domain # trials peak rms For p between 0.001 and 1: IEEE 0,100 100000 4.3e-15 2.6e-16 See also incbet.c. ERROR MESSAGES: message condition value returned bdtr domain k < 0 0.0 n < k x < 0, x > 1 =item I: Complemented binomial distribution SYNOPSIS: # int k, n; # double p, y, bdtrc(); $y = bdtrc( $k, $n, $p ); DESCRIPTION: Returns the sum of the terms k+1 through n of the Binomial probability density: n -- ( n ) j n-j > ( ) p (1-p) -- ( j ) j=k+1 The terms are not summed directly; instead the incomplete beta integral is employed, according to the formula y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ). The arguments must be positive, with p ranging from 0 to 1. ACCURACY: Tested at random points (a,b,p). a,b Relative error: arithmetic domain # trials peak rms For p between 0.001 and 1: IEEE 0,100 100000 6.7e-15 8.2e-16 For p between 0 and .001: IEEE 0,100 100000 1.5e-13 2.7e-15 ERROR MESSAGES: message condition value returned bdtrc domain x<0, x>1, n: Inverse binomial distribution SYNOPSIS: # int k, n; # double p, y, bdtri(); $p = bdtr( $k, $n, $y ); DESCRIPTION: Finds the event probability p such that the sum of the terms 0 through k of the Binomial probability density is equal to the given cumulative probability y. This is accomplished using the inverse beta integral function and the relation 1 - p = incbi( n-k, k+1, y ). ACCURACY: Tested at random points (a,b,p). a,b Relative error: arithmetic domain # trials peak rms For p between 0.001 and 1: IEEE 0,100 100000 2.3e-14 6.4e-16 IEEE 0,10000 100000 6.6e-12 1.2e-13 For p between 10^-6 and 0.001: IEEE 0,100 100000 2.0e-12 1.3e-14 IEEE 0,10000 100000 1.5e-12 3.2e-14 See also incbi.c. ERROR MESSAGES: message condition value returned bdtri domain k < 0, n <= k 0.0 x < 0, x > 1 =item I: Beta function SYNOPSIS: # double a, b, y, beta(); $y = beta( $a, $b ); DESCRIPTION: - - | (a) | (b) beta( a, b ) = -----------. - | (a+b) For large arguments the logarithm of the function is evaluated using lgam(), then exponentiated. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0,30 1700 7.7e-15 1.5e-15 IEEE 0,30 30000 8.1e-14 1.1e-14 ERROR MESSAGES: message condition value returned beta overflow log(beta) > MAXLOG 0.0 a or b <0 integer 0.0 =item I: Natural logarithm of |beta| SYNOPSIS: # double a, b; # double lbeta( a, b ); $y = lbeta( $a, $b); =item I: Beta distribution SYNOPSIS: # double a, b, x, y, btdtr(); $y = btdtr( $a, $b, $x ); DESCRIPTION: Returns the area from zero to x under the beta density function: x - - | (a+b) | | a-1 b-1 P(x) = ---------- | t (1-t) dt - - | | | (a) | (b) - 0 This function is identical to the incomplete beta integral function incbet(a, b, x). The complemented function is 1 - P(1-x) = incbet( b, a, x ); ACCURACY: See incbet.c. =item I: Cube root SYNOPSIS: # double x, y, cbrt(); $y = cbrt( $x ); DESCRIPTION: Returns the cube root of the argument, which may be negative. Range reduction involves determining the power of 2 of the argument. A polynomial of degree 2 applied to the mantissa, and multiplication by the cube root of 1, 2, or 4 approximates the root to within about 0.1%. Then Newton's iteration is used three times to converge to an accurate result. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -10,10 200000 1.8e-17 6.2e-18 IEEE 0,1e308 30000 1.5e-16 5.0e-17 =item I: Chi-square distribution SYNOPSIS: # double v, x, y, chdtr(); $y = chdtr( $v, $x ); DESCRIPTION: Returns the area under the left hand tail (from 0 to x) of the Chi square probability density function with v degrees of freedom. inf. - 1 | | v/2-1 -t/2 P( x | v ) = ----------- | t e dt v/2 - | | 2 | (v/2) - x where x is the Chi-square variable. The incomplete gamma integral is used, according to the formula y = chdtr( v, x ) = igam( v/2.0, x/2.0 ). The arguments must both be positive. ACCURACY: See igam(). ERROR MESSAGES: message condition value returned chdtr domain x < 0 or v < 1 0.0 =item I: Complemented Chi-square distribution SYNOPSIS: # double v, x, y, chdtrc(); $y = chdtrc( $v, $x ); DESCRIPTION: Returns the area under the right hand tail (from x to infinity) of the Chi square probability density function with v degrees of freedom: inf. - 1 | | v/2-1 -t/2 P( x | v ) = ----------- | t e dt v/2 - | | 2 | (v/2) - x where x is the Chi-square variable. The incomplete gamma integral is used, according to the formula y = chdtrc( v, x ) = igamc( v/2.0, x/2.0 ). The arguments must both be positive. ACCURACY: See igamc(). ERROR MESSAGES: message condition value returned chdtrc domain x < 0 or v < 1 0.0 =item I: Inverse of complemented Chi-square distribution SYNOPSIS: # double df, x, y, chdtri(); $x = chdtri( $df, $y ); DESCRIPTION: Finds the Chi-square argument x such that the integral from x to infinity of the Chi-square density is equal to the given cumulative probability y. This is accomplished using the inverse gamma integral function and the relation x/2 = igami( df/2, y ); ACCURACY: See igami.c. ERROR MESSAGES: message condition value returned chdtri domain y < 0 or y > 1 0.0 v < 1 =item I: Complex natural logarithm SYNOPSIS: # void clog(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); clog($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: Returns complex logarithm to the base e (2.718...) of the complex argument x. If z = x + iy, r = sqrt( x**2 + y**2 ), then w = log(r) + i arctan(y/x). The arctangent ranges from -PI to +PI. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -10,+10 7000 8.5e-17 1.9e-17 IEEE -10,+10 30000 5.0e-15 1.1e-16 Larger relative error can be observed for z near 1 +i0. In IEEE arithmetic the peak absolute error is 5.2e-16, rms absolute error 1.0e-16. =item I: Complex exponential function SYNOPSIS: # void cexp(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); cexp($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: Returns the exponential of the complex argument z into the complex result w. If z = x + iy, r = exp(x), then w = r cos y + i r sin y. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -10,+10 8700 3.7e-17 1.1e-17 IEEE -10,+10 30000 3.0e-16 8.7e-17 =item I: Complex circular sine SYNOPSIS: # void csin(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); csin($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: If z = x + iy, then w = sin x cosh y + i cos x sinh y. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -10,+10 8400 5.3e-17 1.3e-17 IEEE -10,+10 30000 3.8e-16 1.0e-16 Also tested by csin(casin(z)) = z. =item I: Complex circular cosine SYNOPSIS: # void ccos(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); ccos($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: If z = x + iy, then w = cos x cosh y - i sin x sinh y. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -10,+10 8400 4.5e-17 1.3e-17 IEEE -10,+10 30000 3.8e-16 1.0e-16 =item I: Complex circular tangent SYNOPSIS: # void ctan(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); ctan($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: If z = x + iy, then sin 2x + i sinh 2y w = --------------------. cos 2x + cosh 2y On the real axis the denominator is zero at odd multiples of PI/2. The denominator is evaluated by its Taylor series near these points. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -10,+10 5200 7.1e-17 1.6e-17 IEEE -10,+10 30000 7.2e-16 1.2e-16 Also tested by ctan * ccot = 1 and catan(ctan(z)) = z. =item I: Complex circular cotangent SYNOPSIS: # void ccot(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); ccot($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: If z = x + iy, then sin 2x - i sinh 2y w = --------------------. cosh 2y - cos 2x On the real axis, the denominator has zeros at even multiples of PI/2. Near these points it is evaluated by a Taylor series. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -10,+10 3000 6.5e-17 1.6e-17 IEEE -10,+10 30000 9.2e-16 1.2e-16 Also tested by ctan * ccot = 1 + i0. =item I: Complex circular arc sine SYNOPSIS: # void casin(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); casin($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: Inverse complex sine: 2 w = -i clog( iz + csqrt( 1 - z ) ). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -10,+10 10100 2.1e-15 3.4e-16 IEEE -10,+10 30000 2.2e-14 2.7e-15 Larger relative error can be observed for z near zero. Also tested by csin(casin(z)) = z. =item I: Complex circular arc cosine SYNOPSIS: # void cacos(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); cacos($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: w = arccos z = PI/2 - arcsin z. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -10,+10 5200 1.6e-15 2.8e-16 IEEE -10,+10 30000 1.8e-14 2.2e-15 =item I: Complex circular arc tangent SYNOPSIS: # void catan(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); catan($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: If z = x + iy, then 1 ( 2x ) Re w = - arctan(-----------) + k PI 2 ( 2 2) (1 - x - y ) ( 2 2) 1 (x + (y+1) ) Im w = - log(------------) 4 ( 2 2) (x + (y-1) ) Where k is an arbitrary integer. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -10,+10 5900 1.3e-16 7.8e-18 IEEE -10,+10 30000 2.3e-15 8.5e-17 The check catan( ctan(z) ) = z, with |x| and |y| < PI/2, had peak relative error 1.5e-16, rms relative error 2.9e-17. See also clog(). =item I: Complex hyperbolic sine SYNOPSIS: # void csinh(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); csinh($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: csinh z = (cexp(z) - cexp(-z))/2 = sinh x * cos y + i cosh x * sin y . ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -10,+10 30000 3.1e-16 8.2e-17 =item I: Complex inverse hyperbolic sine SYNOPSIS: # void casinh(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); casinh($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print_new_cmplx($w); # prints $w as Re($w) + i Im($w) DESCRIPTION: casinh z = -i casin iz . ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -10,+10 30000 1.8e-14 2.6e-15 =item I: Complex hyperbolic cosine SYNOPSIS: # void ccosh(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); ccosh($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: ccosh(z) = cosh x cos y + i sinh x sin y . ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -10,+10 30000 2.9e-16 8.1e-17 =item I: Complex inverse hyperbolic cosine SYNOPSIS: # void cacosh(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); cacosh($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: acosh z = i acos z . ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -10,+10 30000 1.6e-14 2.1e-15 =item I: Complex hyperbolic tangent SYNOPSIS: # void ctanh(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); ctanh($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: tanh z = (sinh 2x + i sin 2y) / (cosh 2x + cos 2y) . ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -10,+10 30000 1.7e-14 2.4e-16 =item I: Complex inverse hyperbolic tangent SYNOPSIS: # void catanh(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); catanh($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: Inverse tanh, equal to -i catan (iz); ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -10,+10 30000 2.3e-16 6.2e-17 =item I: Complex power function SYNOPSIS: # void cpow(); # cmplx a, z, w; $a = new_cmplx(5, 6); # $z = 5 + 6 i $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); cpow($a, $z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: Raises complex A to the complex Zth power. Definition is per AMS55 # 4.2.8, analytically equivalent to cpow(a,z) = cexp(z clog(a)). ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -10,+10 30000 9.4e-15 1.5e-15 =item I: Complex number arithmetic SYNOPSIS: # typedef struct { # double r; real part # double i; imaginary part # }cmplx; # cmplx *a, *b, *c; $a = new_cmplx(3, 5); # $a = 3 + 5 i $b = new_cmplx(2, 3); # $b = 2 + 3 i $c = new_cmplx(); cadd( $a, $b, $c ); # c = b + a csub( $a, $b, $c ); # c = b - a cmul( $a, $b, $c ); # c = b * a cdiv( $a, $b, $c ); # c = b / a cneg( $c ); # c = -c cmov( $b, $c ); # c = b print $c->{r}, ' ', $c->{i}; # prints real and imaginary parts of $c DESCRIPTION: Addition: c.r = b.r + a.r c.i = b.i + a.i Subtraction: c.r = b.r - a.r c.i = b.i - a.i Multiplication: c.r = b.r * a.r - b.i * a.i c.i = b.r * a.i + b.i * a.r Division: d = a.r * a.r + a.i * a.i c.r = (b.r * a.r + b.i * a.i)/d c.i = (b.i * a.r - b.r * a.i)/d ACCURACY: In DEC arithmetic, the test (1/z) * z = 1 had peak relative error 3.1e-17, rms 1.2e-17. The test (y/z) * (z/y) = 1 had peak relative error 8.3e-17, rms 2.1e-17. Tests in the rectangle {-10,+10}: Relative error: arithmetic function # trials peak rms DEC cadd 10000 1.4e-17 3.4e-18 IEEE cadd 100000 1.1e-16 2.7e-17 DEC csub 10000 1.4e-17 4.5e-18 IEEE csub 100000 1.1e-16 3.4e-17 DEC cmul 3000 2.3e-17 8.7e-18 IEEE cmul 100000 2.1e-16 6.9e-17 DEC cdiv 18000 4.9e-17 1.3e-17 IEEE cdiv 100000 3.7e-16 1.1e-16 =item I: Complex absolute value SYNOPSIS: # double a, cabs(); # cmplx z; $z = new_cmplx(2, 3); # $z = 2 + 3 i $a = cabs( $z ); DESCRIPTION: If z = x + iy then a = sqrt( x**2 + y**2 ). Overflow and underflow are avoided by testing the magnitudes of x and y before squaring. If either is outside half of the floating point full scale range, both are rescaled. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -30,+30 30000 3.2e-17 9.2e-18 IEEE -10,+10 100000 2.7e-16 6.9e-17 =item I: Complex square root SYNOPSIS: # void csqrt(); # cmplx z, w; $z = new_cmplx(2, 3); # $z = 2 + 3 i $w = new_cmplx(); csqrt($z, $w ); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w DESCRIPTION: If z = x + iy, r = |z|, then 1/2 Im w = [ (r - x)/2 ] , Re w = y / 2 Im w. Note that -w is also a square root of z. The root chosen is always in the upper half plane. Because of the potential for cancellation error in r - x, the result is sharpened by doing a Heron iteration (see sqrt.c) in complex arithmetic. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -10,+10 25000 3.2e-17 9.6e-18 IEEE -10,+10 100000 3.2e-16 7.7e-17 2 Also tested by csqrt( z ) = z, and tested by arguments close to the real axis. =item I: Globally declared constants SYNOPSIS: extern double nameofconstant; DESCRIPTION: This file contains a number of mathematical constants and also some needed size parameters of the computer arithmetic. The values are supplied as arrays of hexadecimal integers for IEEE arithmetic; arrays of octal constants for DEC arithmetic; and in a normal decimal scientific notation for other machines. The particular notation used is determined by a symbol (DEC, IBMPC, or UNK) defined in the include file mconf.h. The default size parameters are as follows. For DEC and UNK modes: MACHEP = 1.38777878078144567553E-17 2**-56 MAXLOG = 8.8029691931113054295988E1 log(2**127) MINLOG = -8.872283911167299960540E1 log(2**-128) MAXNUM = 1.701411834604692317316873e38 2**127 For IEEE arithmetic (IBMPC): MACHEP = 1.11022302462515654042E-16 2**-53 MAXLOG = 7.09782712893383996843E2 log(2**1024) MINLOG = -7.08396418532264106224E2 log(2**-1022) MAXNUM = 1.7976931348623158E308 2**1024 These lists are subject to change. =item I: Hyperbolic cosine SYNOPSIS: # double x, y, cosh(); $y = cosh( $x ); DESCRIPTION: Returns hyperbolic cosine of argument in the range MINLOG to MAXLOG. cosh(x) = ( exp(x) + exp(-x) )/2. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC +- 88 50000 4.0e-17 7.7e-18 IEEE +-MAXLOG 30000 2.6e-16 5.7e-17 ERROR MESSAGES: message condition value returned cosh overflow |x| > MAXLOG MAXNUM =item I: Dawson's Integral SYNOPSIS: # double x, y, dawsn(); $y = dawsn( $x ); DESCRIPTION: Approximates the integral x - 2 | | 2 dawsn(x) = exp( -x ) | exp( t ) dt | | - 0 Three different rational approximations are employed, for the intervals 0 to 3.25; 3.25 to 6.25; and 6.25 up. ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE 0,10 10000 6.9e-16 1.0e-16 DEC 0,10 6000 7.4e-17 1.4e-17 =item I: Pseudorandom number generator SYNOPSIS: # double y, drand(); ($flag, $y) = drand( ); DESCRIPTION: Yields a random number 1.0 <= y < 2.0. The three-generator congruential algorithm by Brian Wichmann and David Hill (BYTE magazine, March, 1987, pp 127-8) is used. The period, given by them, is 6953607871644. Versions invoked by the different arithmetic compile time options DEC, IBMPC, and MIEEE, produce approximately the same sequences, differing only in the least significant bits of the numbers. The UNK option implements the algorithm as recommended in the BYTE article. It may be used on all computers. However, the low order bits of a double precision number may not be adequately random, and may vary due to arithmetic implementation details on different computers. The other compile options generate an additional random integer that overwrites the low order bits of the double precision number. This reduces the period by a factor of two but tends to overcome the problems mentioned. =item I: Incomplete elliptic integral of the second kind SYNOPSIS: # double phi, m, y, ellie(); $y = ellie( $phi, $m ); DESCRIPTION: Approximates the integral phi - | | | 2 E(phi_\m) = | sqrt( 1 - m sin t ) dt | | | - 0 of amplitude phi and modulus m, using the arithmetic - geometric mean algorithm. ACCURACY: Tested at random arguments with phi in [-10, 10] and m in [0, 1]. Relative error: arithmetic domain # trials peak rms DEC 0,2 2000 1.9e-16 3.4e-17 IEEE -10,10 150000 3.3e-15 1.4e-16 =item I: Incomplete elliptic integral of the first kind SYNOPSIS: # double phi, m, y, ellik(); $y = ellik( $phi, $m ); DESCRIPTION: Approximates the integral phi - | | | dt F(phi_\m) = | ------------------ | 2 | | sqrt( 1 - m sin t ) - 0 of amplitude phi and modulus m, using the arithmetic - geometric mean algorithm. ACCURACY: Tested at random points with m in [0, 1] and phi as indicated. Relative error: arithmetic domain # trials peak rms IEEE -10,10 200000 7.4e-16 1.0e-16 =item I: Complete elliptic integral of the second kind SYNOPSIS: # double m1, y, ellpe(); $y = ellpe( $m1 ); DESCRIPTION: Approximates the integral pi/2 - | | 2 E(m) = | sqrt( 1 - m sin t ) dt | | - 0 Where m = 1 - m1, using the approximation P(x) - x log x Q(x). Though there are no singularities, the argument m1 is used rather than m for compatibility with ellpk(). E(1) = 1; E(0) = pi/2. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0, 1 13000 3.1e-17 9.4e-18 IEEE 0, 1 10000 2.1e-16 7.3e-17 ERROR MESSAGES: message condition value returned ellpe domain x<0, x>1 0.0 =item I: Jacobian Elliptic Functions SYNOPSIS: # double u, m, sn, cn, dn, phi; # int ellpj(); ($flag, $sn, $cn, $dn, $phi) = ellpj( $u, $m ); DESCRIPTION: Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m), and dn(u|m) of parameter m between 0 and 1, and real argument u. These functions are periodic, with quarter-period on the real axis equal to the complete elliptic integral ellpk(1.0-m). Relation to incomplete elliptic integral: If u = ellik(phi,m), then sn(u|m) = sin(phi), and cn(u|m) = cos(phi). Phi is called the amplitude of u. Computation is by means of the arithmetic-geometric mean algorithm, except when m is within 1e-9 of 0 or 1. In the latter case with m close to 1, the approximation applies only for phi < pi/2. ACCURACY: Tested at random points with u between 0 and 10, m between 0 and 1. Absolute error (* = relative error): arithmetic function # trials peak rms DEC sn 1800 4.5e-16 8.7e-17 IEEE phi 10000 9.2e-16* 1.4e-16* IEEE sn 50000 4.1e-15 4.6e-16 IEEE cn 40000 3.6e-15 4.4e-16 IEEE dn 10000 1.3e-12 1.8e-14 Peak error observed in consistency check using addition theorem for sn(u+v) was 4e-16 (absolute). Also tested by the above relation to the incomplete elliptic integral. Accuracy deteriorates when u is large. =item I: Complete elliptic integral of the first kind SYNOPSIS: # double m1, y, ellpk(); $y = ellpk( $m1 ); DESCRIPTION: Approximates the integral pi/2 - | | | dt K(m) = | ------------------ | 2 | | sqrt( 1 - m sin t ) - 0 where m = 1 - m1, using the approximation P(x) - log x Q(x). The argument m1 is used rather than m so that the logarithmic singularity at m = 1 will be shifted to the origin; this preserves maximum accuracy. K(0) = pi/2. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0,1 16000 3.5e-17 1.1e-17 IEEE 0,1 30000 2.5e-16 6.8e-17 ERROR MESSAGES: message condition value returned ellpk domain x<0, x>1 0.0 =item I: Rational arithmetic routines SYNOPSIS: # typedef struct # { # double n; numerator # double d; denominator # }fract; $a = new_fract(3, 4); # a = 3 / 4 $b = new_fract(2, 3); # b = 2 / 3 $c = new_fract(); radd( $a, $b, $c ); # c = b + a rsub( $a, $b, $c ); # c = b - a rmul( $a, $b, $c ); # c = b * a rdiv( $a, $b, $c ); # c = b / a print $c->{n}, ' ', $c->{d}; # prints numerator and denominator of $c ($gcd, $m_reduced, $n_reduced) = euclid($m, $n); # returns the greatest common divisor of $m and $n, as well as # the result of reducing $m and $n by $gcd Arguments of the routines are pointers to the structures. The double precision numbers are assumed, without checking, to be integer valued. Overflow conditions are reported. =item I: Exponential function SYNOPSIS: # double x, y, exp(); $y = exp( $x ); DESCRIPTION: Returns e (2.71828...) raised to the x power. Range reduction is accomplished by separating the argument into an integer k and fraction f such that x k f e = 2 e. A Pade' form 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) of degree 2/3 is used to approximate exp(f) in the basic interval [-0.5, 0.5]. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC +- 88 50000 2.8e-17 7.0e-18 IEEE +- 708 40000 2.0e-16 5.6e-17 Error amplification in the exponential function can be a serious matter. The error propagation involves exp( X(1+delta) ) = exp(X) ( 1 + X*delta + ... ), which shows that a 1 lsb error in representing X produces a relative error of X times 1 lsb in the function. While the routine gives an accurate result for arguments that are exactly represented by a double precision computer number, the result contains amplified roundoff error for large arguments not exactly represented. ERROR MESSAGES: message condition value returned exp underflow x < MINLOG 0.0 exp overflow x > MAXLOG INFINITY =item I: exp(x*x) # double x, y, expxx(); # int sign; $y = expxx( $x, $sign ); DESCRIPTION: Computes y = exp(x*x) while suppressing error amplification that would ordinarily arise from the inexactness of the exponential argument x*x. If sign < 0, exp(-x*x) is returned. If sign > 0, or omitted, exp(x*x) is returned. ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -26.6, 26.6 10^7 3.9e-16 8.9e-17 =item I: Base 10 exponential function (Common antilogarithm) SYNOPSIS: # double x, y, exp10(); $y = exp10( $x ); DESCRIPTION: Returns 10 raised to the x power. Range reduction is accomplished by expressing the argument as 10**x = 2**n 10**f, with |f| < 0.5 log10(2). The Pade' form 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) is used to approximate 10**f. ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -307,+307 30000 2.2e-16 5.5e-17 Test result from an earlier version (2.1): DEC -38,+38 70000 3.1e-17 7.0e-18 ERROR MESSAGES: message condition value returned exp10 underflow x < -MAXL10 0.0 exp10 overflow x > MAXL10 MAXNUM DEC arithmetic: MAXL10 = 38.230809449325611792. IEEE arithmetic: MAXL10 = 308.2547155599167. =item I: Base 2 exponential function SYNOPSIS: # double x, y, exp2(); $y = exp2( $x ); DESCRIPTION: Returns 2 raised to the x power. Range reduction is accomplished by separating the argument into an integer k and fraction f such that x k f 2 = 2 2. A Pade' form 1 + 2x P(x**2) / (Q(x**2) - x P(x**2) ) approximates 2**x in the basic range [-0.5, 0.5]. ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -1022,+1024 30000 1.8e-16 5.4e-17 See exp.c for comments on error amplification. ERROR MESSAGES: message condition value returned exp underflow x < -MAXL2 0.0 exp overflow x > MAXL2 MAXNUM For DEC arithmetic, MAXL2 = 127. For IEEE arithmetic, MAXL2 = 1024. =item I: Exponential integral SYNOPSIS: #double x, y, ei(); $y = ei( $x ); DESCRIPTION: x - t | | e Ei(x) = -|- --- dt . | | t - -inf Not defined for x <= 0. See also expn.c. ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE 0,100 50000 8.6e-16 1.3e-16 =item I: Exponential integral En SYNOPSIS: # int n; # double x, y, expn(); $y = expn( $n, $x ); DESCRIPTION: Evaluates the exponential integral inf. - | | -xt | e E (x) = | ---- dt. n | n | | t - 1 Both n and x must be nonnegative. The routine employs either a power series, a continued fraction, or an asymptotic formula depending on the relative values of n and x. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0, 30 5000 2.0e-16 4.6e-17 IEEE 0, 30 10000 1.7e-15 3.6e-16 =item I: Absolute value SYNOPSIS: # double x, y; $y = fabs( $x ); DESCRIPTION: Returns the absolute value of the argument. =item I: Factorial function SYNOPSIS: # double y, fac(); # int i; $y = fac( $i ); DESCRIPTION: Returns factorial of i = 1 * 2 * 3 * ... * i. fac(0) = 1.0. Due to machine arithmetic bounds the largest value of i accepted is 33 in DEC arithmetic or 170 in IEEE arithmetic. Greater values, or negative ones, produce an error message and return MAXNUM. ACCURACY: For i < 34 the values are simply tabulated, and have full machine accuracy. If i > 55, fac(i) = gamma(i+1); see gamma.c. Relative error: arithmetic domain peak IEEE 0, 170 1.4e-15 DEC 0, 33 1.4e-17 =item I: F distribution SYNOPSIS: # int df1, df2; # double x, y, fdtr(); $y = fdtr( $df1, $df2, $x ); DESCRIPTION: Returns the area from zero to x under the F density function (also known as Snedcor's density or the variance ratio density). This is the density of x = (u1/df1)/(u2/df2), where u1 and u2 are random variables having Chi square distributions with df1 and df2 degrees of freedom, respectively. The incomplete beta integral is used, according to the formula P(x) = incbet( df1/2, df2/2, df1*x/(df2 + df1*x) ). The arguments a and b are greater than zero, and x is nonnegative. ACCURACY: Tested at random points (a,b,x). x a,b Relative error: arithmetic domain domain # trials peak rms IEEE 0,1 0,100 100000 9.8e-15 1.7e-15 IEEE 1,5 0,100 100000 6.5e-15 3.5e-16 IEEE 0,1 1,10000 100000 2.2e-11 3.3e-12 IEEE 1,5 1,10000 100000 1.1e-11 1.7e-13 See also incbet.c. ERROR MESSAGES: message condition value returned fdtr domain a<0, b<0, x<0 0.0 =item I: Complemented F distribution SYNOPSIS: # int df1, df2; # double x, y, fdtrc(); $y = fdtrc( $df1, $df2, $x ); DESCRIPTION: Returns the area from x to infinity under the F density function (also known as Snedcor's density or the variance ratio density). inf. - 1 | | a-1 b-1 1-P(x) = ------ | t (1-t) dt B(a,b) | | - x The incomplete beta integral is used, according to the formula P(x) = incbet( df2/2, df1/2, df2/(df2 + df1*x) ). ACCURACY: Tested at random points (a,b,x) in the indicated intervals. x a,b Relative error: arithmetic domain domain # trials peak rms IEEE 0,1 1,100 100000 3.7e-14 5.9e-16 IEEE 1,5 1,100 100000 8.0e-15 1.6e-15 IEEE 0,1 1,10000 100000 1.8e-11 3.5e-13 IEEE 1,5 1,10000 100000 2.0e-11 3.0e-12 See also incbet.c. ERROR MESSAGES: message condition value returned fdtrc domain a<0, b<0, x<0 0.0 =item I: Inverse of complemented F distribution SYNOPSIS: # int df1, df2; # double x, p, fdtri(); $x = fdtri( $df1, $df2, $p ); DESCRIPTION: Finds the F density argument x such that the integral from x to infinity of the F density is equal to the given probability p. This is accomplished using the inverse beta integral function and the relations z = incbi( df2/2, df1/2, p ) x = df2 (1-z) / (df1 z). Note: the following relations hold for the inverse of the uncomplemented F distribution: z = incbi( df1/2, df2/2, p ) x = df2 z / (df1 (1-z)). ACCURACY: Tested at random points (a,b,p). a,b Relative error: arithmetic domain # trials peak rms For p between .001 and 1: IEEE 1,100 100000 8.3e-15 4.7e-16 IEEE 1,10000 100000 2.1e-11 1.4e-13 For p between 10^-6 and 10^-3: IEEE 1,100 50000 1.3e-12 8.4e-15 IEEE 1,10000 50000 3.0e-12 4.8e-14 See also fdtrc.c. ERROR MESSAGES: message condition value returned fdtri domain p <= 0 or p > 1 0.0 v < 1 =item I: ceil ceil() returns the smallest integer greater than or equal to x. It truncates toward plus infinity. SYNOPSIS: # double x, y, ceil(); $y = ceil( $x ); =item I: floor floor() returns the largest integer less than or equal to x. It truncates toward minus infinity. SYNOPSIS: # double x, y, floor(); $y = floor( $x ); =item I: frexp frexp() extracts the exponent from x. It returns an integer power of two to expnt and the significand between 0.5 and 1 to y. Thus x = y * 2**expn. SYNOPSIS: # double x, y, frexp(); # int expnt; ($y, $expnt) = frexp( $x ); =item I: multiplies x by 2**n. SYNOPSIS: # double x, y, ldexp(); # int n; $y = ldexp( $x, $n ); =item I: Fresnel integral SYNOPSIS: # double x, S, C; # void fresnl(); ($flag, $S, $C) = fresnl( $x ); DESCRIPTION: Evaluates the Fresnel integrals x - | | C(x) = | cos(pi/2 t**2) dt, | | - 0 x - | | S(x) = | sin(pi/2 t**2) dt. | | - 0 The integrals are evaluated by a power series for x < 1. For x >= 1 auxiliary functions f(x) and g(x) are employed such that C(x) = 0.5 + f(x) sin( pi/2 x**2 ) - g(x) cos( pi/2 x**2 ) S(x) = 0.5 - f(x) cos( pi/2 x**2 ) - g(x) sin( pi/2 x**2 ) ACCURACY: Relative error. Arithmetic function domain # trials peak rms IEEE S(x) 0, 10 10000 2.0e-15 3.2e-16 IEEE C(x) 0, 10 10000 1.8e-15 3.3e-16 DEC S(x) 0, 10 6000 2.2e-16 3.9e-17 DEC C(x) 0, 10 5000 2.3e-16 3.9e-17 =item I: Gamma function SYNOPSIS: # double x, y, gamma(); # extern int sgngam; $y = gamma( $x ); DESCRIPTION: Returns gamma function of the argument. The result is correctly signed, and the sign (+1 or -1) is also returned in a global (extern) variable named sgngam. This variable is also filled in by the logarithmic gamma function lgam(). Arguments |x| <= 34 are reduced by recurrence and the function approximated by a rational function of degree 6/7 in the interval (2,3). Large arguments are handled by Stirling's formula. Large negative arguments are made positive using a reflection formula. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -34, 34 10000 1.3e-16 2.5e-17 IEEE -170,-33 20000 2.3e-15 3.3e-16 IEEE -33, 33 20000 9.4e-16 2.2e-16 IEEE 33, 171.6 20000 2.3e-15 3.2e-16 Error for arguments outside the test range will be larger owing to error amplification by the exponential function. =item I: Natural logarithm of gamma function SYNOPSIS: # double x, y, lgam(); # extern int sgngam; $y = lgam( $x ); DESCRIPTION: Returns the base e (2.718...) logarithm of the absolute value of the gamma function of the argument. The sign (+1 or -1) of the gamma function is returned in a global (extern) variable named sgngam. For arguments greater than 13, the logarithm of the gamma function is approximated by the logarithmic version of Stirling's formula using a polynomial approximation of degree 4. Arguments between -33 and +33 are reduced by recurrence to the interval [2,3] of a rational approximation. The cosecant reflection formula is employed for arguments less than -33. Arguments greater than MAXLGM return MAXNUM and an error message. MAXLGM = 2.035093e36 for DEC arithmetic or 2.556348e305 for IEEE arithmetic. ACCURACY: arithmetic domain # trials peak rms DEC 0, 3 7000 5.2e-17 1.3e-17 DEC 2.718, 2.035e36 5000 3.9e-17 9.9e-18 IEEE 0, 3 28000 5.4e-16 1.1e-16 IEEE 2.718, 2.556e305 40000 3.5e-16 8.3e-17 The error criterion was relative when the function magnitude was greater than one but absolute when it was less than one. The following test used the relative error criterion, though at certain points the relative error could be much higher than indicated. IEEE -200, -4 10000 4.8e-16 1.3e-16 =item I: Gamma distribution function SYNOPSIS: # double a, b, x, y, gdtr(); $y = gdtr( $a, $b, $x ); DESCRIPTION: Returns the integral from zero to x of the gamma probability density function: x b - a | | b-1 -at y = ----- | t e dt - | | | (b) - 0 The incomplete gamma integral is used, according to the relation y = igam( b, ax ). ACCURACY: See igam(). ERROR MESSAGES: message condition value returned gdtr domain x < 0 0.0 =item I: Complemented gamma distribution function SYNOPSIS: # double a, b, x, y, gdtrc(); $y = gdtrc( $a, $b, $x ); DESCRIPTION: Returns the integral from x to infinity of the gamma probability density function: inf. b - a | | b-1 -at y = ----- | t e dt - | | | (b) - x The incomplete gamma integral is used, according to the relation y = igamc( b, ax ). ACCURACY: See igamc(). ERROR MESSAGES: message condition value returned gdtrc domain x < 0 0.0 =item I: Gauss hypergeometric function 2F0 SYNOPSIS: # double a, b, x, value, *err; # int type; /* determines what converging factor to use */ ($value, $err) = hyp2f0( $a, $b, $x, $type ) =item I: Gauss hypergeometric function 2F1 SYNOPSIS: # double a, b, c, x, y, hyp2f1(); $y = hyp2f1( $a, $b, $c, $x ); DESCRIPTION: hyp2f1( a, b, c, x ) = F ( a, b; c; x ) 2 1 inf. - a(a+1)...(a+k) b(b+1)...(b+k) k+1 = 1 + > ----------------------------- x . - c(c+1)...(c+k) (k+1)! k = 0 Cases addressed are Tests and escapes for negative integer a, b, or c Linear transformation if c - a or c - b negative integer Special case c = a or c = b Linear transformation for x near +1 Transformation for x < -0.5 Psi function expansion if x > 0.5 and c - a - b integer Conditionally, a recurrence on c to make c-a-b > 0 |x| > 1 is rejected. The parameters a, b, c are considered to be integer valued if they are within 1.0e-14 of the nearest integer (1.0e-13 for IEEE arithmetic). ACCURACY: Relative error (-1 < x < 1): arithmetic domain # trials peak rms IEEE -1,7 230000 1.2e-11 5.2e-14 Several special cases also tested with a, b, c in the range -7 to 7. ERROR MESSAGES: A "partial loss of precision" message is printed if the internally estimated relative error exceeds 1^-12. A "singularity" message is printed on overflow or in cases not addressed (such as x < -1). =item I: Confluent hypergeometric function SYNOPSIS: # double a, b, x, y, hyperg(); $y = hyperg( $a, $b, $x ); DESCRIPTION: Computes the confluent hypergeometric function 1 2 a x a(a+1) x F ( a,b;x ) = 1 + ---- + --------- + ... 1 1 b 1! b(b+1) 2! Many higher transcendental functions are special cases of this power series. As is evident from the formula, b must not be a negative integer or zero unless a is an integer with 0 >= a > b. The routine attempts both a direct summation of the series and an asymptotic expansion. In each case error due to roundoff, cancellation, and nonconvergence is estimated. The result with smaller estimated error is returned. ACCURACY: Tested at random points (a, b, x), all three variables ranging from 0 to 30. Relative error: arithmetic domain # trials peak rms DEC 0,30 2000 1.2e-15 1.3e-16 IEEE 0,30 30000 1.8e-14 1.1e-15 Larger errors can be observed when b is near a negative integer or zero. Certain combinations of arguments yield serious cancellation error in the power series summation and also are not in the region of near convergence of the asymptotic series. An error message is printed if the self-estimated relative error is greater than 1.0e-12. =item I: Modified Bessel function of order zero SYNOPSIS: # double x, y, i0(); $y = i0( $x ); DESCRIPTION: Returns modified Bessel function of order zero of the argument. The function is defined as i0(x) = j0( ix ). The range is partitioned into the two intervals [0,8] and (8, infinity). Chebyshev polynomial expansions are employed in each interval. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0,30 6000 8.2e-17 1.9e-17 IEEE 0,30 30000 5.8e-16 1.4e-16 =item I: Modified Bessel function of order zero, exponentially scaled SYNOPSIS: # double x, y, i0e(); $y = i0e( $x ); DESCRIPTION: Returns exponentially scaled modified Bessel function of order zero of the argument. The function is defined as i0e(x) = exp(-|x|) j0( ix ). ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE 0,30 30000 5.4e-16 1.2e-16 See i0(). =item I: Modified Bessel function of order one SYNOPSIS: # double x, y, i1(); $y = i1( $x ); DESCRIPTION: Returns modified Bessel function of order one of the argument. The function is defined as i1(x) = -i j1( ix ). The range is partitioned into the two intervals [0,8] and (8, infinity). Chebyshev polynomial expansions are employed in each interval. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0, 30 3400 1.2e-16 2.3e-17 IEEE 0, 30 30000 1.9e-15 2.1e-16 =item I: Modified Bessel function of order one, exponentially scaled SYNOPSIS: # double x, y, i1e(); $y = i1e( $x ); DESCRIPTION: Returns exponentially scaled modified Bessel function of order one of the argument. The function is defined as i1(x) = -i exp(-|x|) j1( ix ). ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE 0, 30 30000 2.0e-15 2.0e-16 See i1(). =item I: Incomplete gamma integral SYNOPSIS: # double a, x, y, igam(); $y = igam( $a, $x ); DESCRIPTION: The function is defined by x - 1 | | -t a-1 igam(a,x) = ----- | e t dt. - | | | (a) - 0 In this implementation both arguments must be positive. The integral is evaluated by either a power series or continued fraction expansion, depending on the relative values of a and x. ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE 0,30 200000 3.6e-14 2.9e-15 IEEE 0,100 300000 9.9e-14 1.5e-14 =item I: Complemented incomplete gamma integral SYNOPSIS: # double a, x, y, igamc(); $y = igamc( $a, $x ); DESCRIPTION: The function is defined by igamc(a,x) = 1 - igam(a,x) inf. - 1 | | -t a-1 = ----- | e t dt. - | | | (a) - x In this implementation both arguments must be positive. The integral is evaluated by either a power series or continued fraction expansion, depending on the relative values of a and x. ACCURACY: Tested at random a, x. a x Relative error: arithmetic domain domain # trials peak rms IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15 IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15 =item I: Inverse of complemented imcomplete gamma integral SYNOPSIS: # double a, x, p, igami(); $x = igami( $a, $p ); DESCRIPTION: Given p, the function finds x such that igamc( a, x ) = p. It is valid in the right-hand tail of the distribution, p < 0.5. Starting with the approximate value 3 x = a t where t = 1 - d - ndtri(p) sqrt(d) and d = 1/9a, the routine performs up to 10 Newton iterations to find the root of igamc(a,x) - p = 0. ACCURACY: Tested at random a, p in the intervals indicated. a p Relative error: arithmetic domain domain # trials peak rms IEEE 0.5,100 0,0.5 100000 1.0e-14 1.7e-15 IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15 IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14 =item I: Incomplete beta integral SYNOPSIS: # double a, b, x, y, incbet(); $y = incbet( $a, $b, $x ); DESCRIPTION: Returns incomplete beta integral of the arguments, evaluated from zero to x. The function is defined as x - - | (a+b) | | a-1 b-1 ----------- | t (1-t) dt. - - | | | (a) | (b) - 0 The domain of definition is 0 <= x <= 1. In this implementation a and b are restricted to positive values. The integral from x to 1 may be obtained by the symmetry relation 1 - incbet( a, b, x ) = incbet( b, a, 1-x ). The integral is evaluated by a continued fraction expansion or, when b*x is small, by a power series. ACCURACY: Tested at uniformly distributed random points (a,b,x) with a and b in "domain" and x between 0 and 1. Relative error arithmetic domain # trials peak rms IEEE 0,5 10000 6.9e-15 4.5e-16 IEEE 0,85 250000 2.2e-13 1.7e-14 IEEE 0,1000 30000 5.3e-12 6.3e-13 IEEE 0,10000 250000 9.3e-11 7.1e-12 IEEE 0,100000 10000 8.7e-10 4.8e-11 Outputs smaller than the IEEE gradual underflow threshold were excluded from these statistics. ERROR MESSAGES: message condition value returned incbet domain x<0, x>1 0.0 incbet underflow 0.0 =item I: Inverse of imcomplete beta integral SYNOPSIS: # double a, b, x, y, incbi(); $x = incbi( $a, $b, $y ); DESCRIPTION: Given y, the function finds x such that incbet( a, b, x ) = y . The routine performs interval halving or Newton iterations to find the root of incbet(a,b,x) - y = 0. ACCURACY: Relative error: x a,b arithmetic domain domain # trials peak rms IEEE 0,1 .5,10000 50000 5.8e-12 1.3e-13 IEEE 0,1 .25,100 100000 1.8e-13 3.9e-15 IEEE 0,1 0,5 50000 1.1e-12 5.5e-15 VAX 0,1 .5,100 25000 3.5e-14 1.1e-15 With a and b constrained to half-integer or integer values: IEEE 0,1 .5,10000 50000 5.8e-12 1.1e-13 IEEE 0,1 .5,100 100000 1.7e-14 7.9e-16 With a = .5, b constrained to half-integer or integer values: IEEE 0,1 .5,10000 10000 8.3e-11 1.0e-11 =item I: Modified Bessel function of noninteger order SYNOPSIS: # double v, x, y, iv(); $y = iv( $v, $x ); DESCRIPTION: Returns modified Bessel function of order v of the argument. If x is negative, v must be integer valued. The function is defined as Iv(x) = Jv( ix ). It is here computed in terms of the confluent hypergeometric function, according to the formula v -x Iv(x) = (x/2) e hyperg( v+0.5, 2v+1, 2x ) / gamma(v+1) If v is a negative integer, then v is replaced by -v. ACCURACY: Tested at random points (v, x), with v between 0 and 30, x between 0 and 28. Relative error: arithmetic domain # trials peak rms DEC 0,30 2000 3.1e-15 5.4e-16 IEEE 0,30 10000 1.7e-14 2.7e-15 Accuracy is diminished if v is near a negative integer. See also hyperg.c. =item I: Bessel function of order zero SYNOPSIS: # double x, y, j0(); $y = j0( $x ); DESCRIPTION: Returns Bessel function of order zero of the argument. The domain is divided into the intervals [0, 5] and (5, infinity). In the first interval the following rational approximation is used: 2 2 (w - r ) (w - r ) P (w) / Q (w) 1 2 3 8 2 where w = x and the two r's are zeros of the function. In the second interval, the Hankel asymptotic expansion is employed with two rational functions of degree 6/6 and 7/7. ACCURACY: Absolute error: arithmetic domain # trials peak rms DEC 0, 30 10000 4.4e-17 6.3e-18 IEEE 0, 30 60000 4.2e-16 1.1e-16 =item I: Bessel function of the second kind, order zero SYNOPSIS: # double x, y, y0(); $y = y0( $x ); DESCRIPTION: Returns Bessel function of the second kind, of order zero, of the argument. The domain is divided into the intervals [0, 5] and (5, infinity). In the first interval a rational approximation R(x) is employed to compute y0(x) = R(x) + 2 * log(x) * j0(x) / PI. Thus a call to j0() is required. In the second interval, the Hankel asymptotic expansion is employed with two rational functions of degree 6/6 and 7/7. ACCURACY: Absolute error, when y0(x) < 1; else relative error: arithmetic domain # trials peak rms DEC 0, 30 9400 7.0e-17 7.9e-18 IEEE 0, 30 30000 1.3e-15 1.6e-16 =item I: Bessel function of order one SYNOPSIS: # double x, y, j1(); $y = j1( $x ); DESCRIPTION: Returns Bessel function of order one of the argument. The domain is divided into the intervals [0, 8] and (8, infinity). In the first interval a 24 term Chebyshev expansion is used. In the second, the asymptotic trigonometric representation is employed using two rational functions of degree 5/5. ACCURACY: Absolute error: arithmetic domain # trials peak rms DEC 0, 30 10000 4.0e-17 1.1e-17 IEEE 0, 30 30000 2.6e-16 1.1e-16 =item I: Bessel function of second kind of order one SYNOPSIS: # double x, y, y1(); $y = y1( $x ); DESCRIPTION: Returns Bessel function of the second kind of order one of the argument. The domain is divided into the intervals [0, 8] and (8, infinity). In the first interval a 25 term Chebyshev expansion is used, and a call to j1() is required. In the second, the asymptotic trigonometric representation is employed using two rational functions of degree 5/5. ACCURACY: Absolute error: arithmetic domain # trials peak rms DEC 0, 30 10000 8.6e-17 1.3e-17 IEEE 0, 30 30000 1.0e-15 1.3e-16 (error criterion relative when |y1| > 1). =item I: Bessel function of integer order SYNOPSIS: # int n; # double x, y, jn(); $y = jn( $n, $x ); DESCRIPTION: Returns Bessel function of order n, where n is a (possibly negative) integer. The ratio of jn(x) to j0(x) is computed by backward recurrence. First the ratio jn/jn-1 is found by a continued fraction expansion. Then the recurrence relating successive orders is applied until j0 or j1 is reached. If n = 0 or 1 the routine for j0 or j1 is called directly. ACCURACY: Absolute error: arithmetic range # trials peak rms DEC 0, 30 5500 6.9e-17 9.3e-18 IEEE 0, 30 5000 4.4e-16 7.9e-17 Not suitable for large n or x. Use jv() instead. =item I: Bessel function of noninteger order SYNOPSIS: # double v, x, y, jv(); $y = jv( $v, $x ); DESCRIPTION: Returns Bessel function of order v of the argument, where v is real. Negative x is allowed if v is an integer. Several expansions are included: the ascending power series, the Hankel expansion, and two transitional expansions for large v. If v is not too large, it is reduced by recurrence to a region of best accuracy. The transitional expansions give 12D accuracy for v > 500. ACCURACY: Results for integer v are indicated by *, where x and v both vary from -125 to +125. Otherwise, x ranges from 0 to 125, v ranges as indicated by "domain." Error criterion is absolute, except relative when |jv()| > 1. arithmetic v domain x domain # trials peak rms IEEE 0,125 0,125 100000 4.6e-15 2.2e-16 IEEE -125,0 0,125 40000 5.4e-11 3.7e-13 IEEE 0,500 0,500 20000 4.4e-15 4.0e-16 Integer v: IEEE -125,125 -125,125 50000 3.5e-15* 1.9e-16* =item I: Modified Bessel function, third kind, order zero SYNOPSIS: # double x, y, k0(); $y = k0( $x ); DESCRIPTION: Returns modified Bessel function of the third kind of order zero of the argument. The range is partitioned into the two intervals [0,8] and (8, infinity). Chebyshev polynomial expansions are employed in each interval. ACCURACY: Tested at 2000 random points between 0 and 8. Peak absolute error (relative when K0 > 1) was 1.46e-14; rms, 4.26e-15. Relative error: arithmetic domain # trials peak rms DEC 0, 30 3100 1.3e-16 2.1e-17 IEEE 0, 30 30000 1.2e-15 1.6e-16 ERROR MESSAGES: message condition value returned K0 domain x <= 0 MAXNUM =item I: Modified Bessel function, third kind, order zero, exponentially scaled SYNOPSIS: # double x, y, k0e(); $y = k0e( $x ); DESCRIPTION: Returns exponentially scaled modified Bessel function of the third kind of order zero of the argument. k0e(x) = exp(x) * k0(x). ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE 0, 30 30000 1.4e-15 1.4e-16 See k0(). =item I: Modified Bessel function, third kind, order one SYNOPSIS: # double x, y, k1(); $y = k1( $x ); DESCRIPTION: Computes the modified Bessel function of the third kind of order one of the argument. The range is partitioned into the two intervals [0,2] and (2, infinity). Chebyshev polynomial expansions are employed in each interval. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0, 30 3300 8.9e-17 2.2e-17 IEEE 0, 30 30000 1.2e-15 1.6e-16 ERROR MESSAGES: message condition value returned k1 domain x <= 0 MAXNUM =item I: Modified Bessel function, third kind, order one, exponentially scaled SYNOPSIS: # double x, y, k1e(); $y = k1e( $x ); DESCRIPTION: Returns exponentially scaled modified Bessel function of the third kind of order one of the argument: k1e(x) = exp(x) * k1(x). ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE 0, 30 30000 7.8e-16 1.2e-16 See k1(). =item I: Modified Bessel function, third kind, integer order SYNOPSIS: # double x, y, kn(); # int n; $y = kn( $n, $x ); DESCRIPTION: Returns modified Bessel function of the third kind of order n of the argument. The range is partitioned into the two intervals [0,9.55] and (9.55, infinity). An ascending power series is used in the low range, and an asymptotic expansion in the high range. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0,30 3000 1.3e-9 5.8e-11 IEEE 0,30 90000 1.8e-8 3.0e-10 Error is high only near the crossover point x = 9.55 between the two expansions used. =item I: Natural logarithm SYNOPSIS: # double x, y, log(); $y = log( $x ); DESCRIPTION: Returns the base e (2.718...) logarithm of x. The argument is separated into its exponent and fractional parts. If the exponent is between -1 and +1, the logarithm of the fraction is approximated by log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). Otherwise, setting z = 2(x-1)/x+1), log(x) = z + z**3 P(z)/Q(z). ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE 0.5, 2.0 150000 1.44e-16 5.06e-17 IEEE +-MAXNUM 30000 1.20e-16 4.78e-17 DEC 0, 10 170000 1.8e-17 6.3e-18 In the tests over the interval [+-MAXNUM], the logarithms of the random arguments were uniformly distributed over [0, MAXLOG]. ERROR MESSAGES: log singularity: x = 0; returns -INFINITY log domain: x < 0; returns NAN =item I: Common logarithm SYNOPSIS: # double x, y, log10(); $y = log10( $x ); DESCRIPTION: Returns logarithm to the base 10 of x. The argument is separated into its exponent and fractional parts. The logarithm of the fraction is approximated by log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE 0.5, 2.0 30000 1.5e-16 5.0e-17 IEEE 0, MAXNUM 30000 1.4e-16 4.8e-17 DEC 1, MAXNUM 50000 2.5e-17 6.0e-18 In the tests over the interval [1, MAXNUM], the logarithms of the random arguments were uniformly distributed over [0, MAXLOG]. ERROR MESSAGES: log10 singularity: x = 0; returns -INFINITY log10 domain: x < 0; returns NAN =item I: Base 2 logarithm SYNOPSIS: # double x, y, log2(); $y = log2( $x ); DESCRIPTION: Returns the base 2 logarithm of x. The argument is separated into its exponent and fractional parts. If the exponent is between -1 and +1, the base e logarithm of the fraction is approximated by log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). Otherwise, setting z = 2(x-1)/x+1), log(x) = z + z**3 P(z)/Q(z). ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE 0.5, 2.0 30000 2.0e-16 5.5e-17 IEEE exp(+-700) 40000 1.3e-16 4.6e-17 In the tests over the interval [exp(+-700)], the logarithms of the random arguments were uniformly distributed. ERROR MESSAGES: log2 singularity: x = 0; returns -INFINITY log2 domain: x < 0; returns NAN =item I: Pseudorandom number generator SYNOPSIS: long y, lrand(); $y = lrand( ); DESCRIPTION: Yields a long integer random number. The three-generator congruential algorithm by Brian Wichmann and David Hill (BYTE magazine, March, 1987, pp 127-8) is used. The period, given by them, is 6953607871644. =item I: Integer square root SYNOPSIS: long x, y; long lsqrt(); $y = lsqrt( $x ); DESCRIPTION: Returns a long integer square root of the long integer argument. The computation is by binary long division. The largest possible result is lsqrt(2,147,483,647) = 46341. If x < 0, the square root of |x| is returned, and an error message is printed. ACCURACY: An extra, roundoff, bit is computed; hence the result is the nearest integer to the actual square root. NOTE: only DEC arithmetic is currently supported. =item I: Library common error handling routine SYNOPSIS: char *fctnam; # int code; # int mtherr(); mtherr( $fctnam, $code ); DESCRIPTION: This routine may be called to report one of the following error conditions (in the include file mconf.h). Mnemonic Value Significance DOMAIN 1 argument domain error SING 2 function singularity OVERFLOW 3 overflow range error UNDERFLOW 4 underflow range error TLOSS 5 total loss of precision PLOSS 6 partial loss of precision EDOM 33 Unix domain error code ERANGE 34 Unix range error code The default version of the file prints the function name, passed to it by the pointer fctnam, followed by the error condition. The display is directed to the standard output device. The routine then returns to the calling program. Users may wish to modify the program to abort by calling exit() under severe error conditions such as domain errors. Since all error conditions pass control to this function, the display may be easily changed, eliminated, or directed to an error logging device. SEE ALSO: mconf.h =item I: Negative binomial distribution SYNOPSIS: # int k, n; # double p, y, nbdtr(); $y = nbdtr( $k, $n, $p ); DESCRIPTION: Returns the sum of the terms 0 through k of the negative binomial distribution: k -- ( n+j-1 ) n j > ( ) p (1-p) -- ( j ) j=0 In a sequence of Bernoulli trials, this is the probability that k or fewer failures precede the nth success. The terms are not computed individually; instead the incomplete beta integral is employed, according to the formula y = nbdtr( k, n, p ) = incbet( n, k+1, p ). The arguments must be positive, with p ranging from 0 to 1. ACCURACY: Tested at random points (a,b,p), with p between 0 and 1. a,b Relative error: arithmetic domain # trials peak rms IEEE 0,100 100000 1.7e-13 8.8e-15 See also incbet.c. =item I: Complemented negative binomial distribution SYNOPSIS: # int k, n; # double p, y, nbdtrc(); $y = nbdtrc( $k, $n, $p ); DESCRIPTION: Returns the sum of the terms k+1 to infinity of the negative binomial distribution: inf -- ( n+j-1 ) n j > ( ) p (1-p) -- ( j ) j=k+1 The terms are not computed individually; instead the incomplete beta integral is employed, according to the formula y = nbdtrc( k, n, p ) = incbet( k+1, n, 1-p ). The arguments must be positive, with p ranging from 0 to 1. ACCURACY: Tested at random points (a,b,p), with p between 0 and 1. a,b Relative error: arithmetic domain # trials peak rms IEEE 0,100 100000 1.7e-13 8.8e-15 See also incbet.c. =item I: Complemented negative binomial distribution SYNOPSIS: # int k, n; # double p, y, nbdtrc(); $y = nbdtrc( $k, $n, $p ); DESCRIPTION: Returns the sum of the terms k+1 to infinity of the negative binomial distribution: inf -- ( n+j-1 ) n j > ( ) p (1-p) -- ( j ) j=k+1 The terms are not computed individually; instead the incomplete beta integral is employed, according to the formula y = nbdtrc( k, n, p ) = incbet( k+1, n, 1-p ). The arguments must be positive, with p ranging from 0 to 1. ACCURACY: See incbet.c. =item I: Functional inverse of negative binomial distribution SYNOPSIS: # int k, n; # double p, y, nbdtri(); $p = nbdtri( $k, $n, $y ); DESCRIPTION: Finds the argument p such that nbdtr(k,n,p) is equal to y. ACCURACY: Tested at random points (a,b,y), with y between 0 and 1. a,b Relative error: arithmetic domain # trials peak rms IEEE 0,100 100000 1.5e-14 8.5e-16 See also incbi.c. =item I: Normal distribution function SYNOPSIS: # double x, y, ndtr(); $y = ndtr( $x ); DESCRIPTION: Returns the area under the Gaussian probability density function, integrated from minus infinity to x: x - 1 | | 2 ndtr(x) = --------- | exp( - t /2 ) dt sqrt(2pi) | | - -inf. = ( 1 + erf(z) ) / 2 where z = x/sqrt(2). Computation is via the functions erf and erfc. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -13,0 8000 2.1e-15 4.8e-16 IEEE -13,0 30000 3.4e-14 6.7e-15 ERROR MESSAGES: message condition value returned erfc underflow x > 37.519379347 0.0 =item I: Error function SYNOPSIS: # double x, y, erf(); $y = erf( $x ); DESCRIPTION: The integral is x - 2 | | 2 erf(x) = -------- | exp( - t ) dt. sqrt(pi) | | - 0 The magnitude of x is limited to 9.231948545 for DEC arithmetic; 1 or -1 is returned outside this range. For 0 <= |x| < 1, erf(x) = x * P4(x**2)/Q5(x**2); otherwise erf(x) = 1 - erfc(x). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0,1 14000 4.7e-17 1.5e-17 IEEE 0,1 30000 3.7e-16 1.0e-16 =item I: Complementary error function SYNOPSIS: # double x, y, erfc(); $y = erfc( $x ); DESCRIPTION: 1 - erf(x) = inf. - 2 | | 2 erfc(x) = -------- | exp( - t ) dt sqrt(pi) | | - x For small x, erfc(x) = 1 - erf(x); otherwise rational approximations are computed. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0, 9.2319 12000 5.1e-16 1.2e-16 IEEE 0,26.6417 30000 5.7e-14 1.5e-14 ERROR MESSAGES: message condition value returned erfc underflow x > 9.231948545 (DEC) 0.0 =item I: Inverse of Normal distribution function SYNOPSIS: # double x, y, ndtri(); $x = ndtri( $y ); DESCRIPTION: Returns the argument, x, for which the area under the Gaussian probability density function (integrated from minus infinity to x) is equal to y. For small arguments 0 < y < exp(-2), the program computes z = sqrt( -2.0 * log(y) ); then the approximation is x = z - log(z)/z - (1/z) P(1/z) / Q(1/z). There are two rational functions P/Q, one for 0 < y < exp(-32) and the other for y up to exp(-2). For larger arguments, w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0.125, 1 5500 9.5e-17 2.1e-17 DEC 6e-39, 0.135 3500 5.7e-17 1.3e-17 IEEE 0.125, 1 20000 7.2e-16 1.3e-16 IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17 ERROR MESSAGES: message condition value returned ndtri domain x <= 0 -MAXNUM ndtri domain x >= 1 MAXNUM =item I: Poisson distribution SYNOPSIS: # int k; # double m, y, pdtr(); $y = pdtr( $k, $m ); DESCRIPTION: Returns the sum of the first k terms of the Poisson distribution: k j -- -m m > e -- -- j! j=0 The terms are not summed directly; instead the incomplete gamma integral is employed, according to the relation y = pdtr( k, m ) = igamc( k+1, m ). The arguments must both be positive. ACCURACY: See igamc(). =item I: Complemented poisson distribution SYNOPSIS: # int k; # double m, y, pdtrc(); $y = pdtrc( $k, $m ); DESCRIPTION: Returns the sum of the terms k+1 to infinity of the Poisson distribution: inf. j -- -m m > e -- -- j! j=k+1 The terms are not summed directly; instead the incomplete gamma integral is employed, according to the formula y = pdtrc( k, m ) = igam( k+1, m ). The arguments must both be positive. ACCURACY: See igam.c. =item I: Inverse Poisson distribution SYNOPSIS: # int k; # double m, y, pdtr(); $m = pdtri( $k, $y ); DESCRIPTION: Finds the Poisson variable x such that the integral from 0 to x of the Poisson density is equal to the given probability y. This is accomplished using the inverse gamma integral function and the relation m = igami( k+1, y ). ACCURACY: See igami.c. ERROR MESSAGES: message condition value returned pdtri domain y < 0 or y >= 1 0.0 k < 0 =item I: Power function SYNOPSIS: # double x, y, z, pow(); $z = pow( $x, $y ); DESCRIPTION: Computes x raised to the yth power. Analytically, x**y = exp( y log(x) ). Following Cody and Waite, this program uses a lookup table of 2**-i/16 and pseudo extended precision arithmetic to obtain an extra three bits of accuracy in both the logarithm and the exponential. ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -26,26 30000 4.2e-16 7.7e-17 DEC -26,26 60000 4.8e-17 9.1e-18 1/26 < x < 26, with log(x) uniformly distributed. -26 < y < 26, y uniformly distributed. IEEE 0,8700 30000 1.5e-14 2.1e-15 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed. ERROR MESSAGES: message condition value returned pow overflow x**y > MAXNUM INFINITY pow underflow x**y < 1/MAXNUM 0.0 pow domain x<0 and y noninteger 0.0 =item I: Real raised to integer power SYNOPSIS: # double x, y, powi(); # int n; $y = powi( $x, $n ); DESCRIPTION: Returns argument x raised to the nth power. The routine efficiently decomposes n as a sum of powers of two. The desired power is a product of two-to-the-kth powers of x. Thus to compute the 32767 power of x requires 28 multiplications instead of 32767 multiplications. ACCURACY: Relative error: arithmetic x domain n domain # trials peak rms DEC .04,26 -26,26 100000 2.7e-16 4.3e-17 IEEE .04,26 -26,26 50000 2.0e-15 3.8e-16 IEEE 1,2 -1022,1023 50000 8.6e-14 1.6e-14 Returns MAXNUM on overflow, zero on underflow. =item I: Psi (digamma) function SYNOPSIS: # double x, y, psi(); $y = psi( $x ); DESCRIPTION: d - psi(x) = -- ln | (x) dx is the logarithmic derivative of the gamma function. For integer x, n-1 - psi(n) = -EUL + > 1/k. - k=1 This formula is used for 0 < n <= 10. If x is negative, it is transformed to a positive argument by the reflection formula psi(1-x) = psi(x) + pi cot(pi x). For general positive x, the argument is made greater than 10 using the recurrence psi(x+1) = psi(x) + 1/x. Then the following asymptotic expansion is applied: inf. B - 2k psi(x) = log(x) - 1/2x - > ------- - 2k k=1 2k x where the B2k are Bernoulli numbers. ACCURACY: Relative error (except absolute when |psi| < 1): arithmetic domain # trials peak rms DEC 0,30 2500 1.7e-16 2.0e-17 IEEE 0,30 30000 1.3e-15 1.4e-16 IEEE -30,0 40000 1.5e-15 2.2e-16 ERROR MESSAGES: message condition value returned psi singularity x integer <=0 MAXNUM =item I: Reciprocal gamma function SYNOPSIS: # double x, y, rgamma(); $y = rgamma( $x ); DESCRIPTION: Returns one divided by the gamma function of the argument. The function is approximated by a Chebyshev expansion in the interval [0,1]. Range reduction is by recurrence for arguments between -34.034 and +34.84425627277176174. 1/MAXNUM is returned for positive arguments outside this range. For arguments less than -34.034 the cosecant reflection formula is applied; lograrithms are employed to avoid unnecessary overflow. The reciprocal gamma function has no singularities, but overflow and underflow may occur for large arguments. These conditions return either MAXNUM or 1/MAXNUM with appropriate sign. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -30,+30 4000 1.2e-16 1.8e-17 IEEE -30,+30 30000 1.1e-15 2.0e-16 For arguments less than -34.034 the peak error is on the order of 5e-15 (DEC), excepting overflow or underflow. =item I: Round double to nearest or even integer valued double SYNOPSIS: # double x, y, round(); $y = round( $x ); DESCRIPTION: Returns the nearest integer to x as a double precision floating point result. If x ends in 0.5 exactly, the nearest even integer is chosen. ACCURACY: If x is greater than 1/(2*MACHEP), its closest machine representation is already an integer, so rounding does not change it. =item I: Hyperbolic sine and cosine integrals SYNOPSIS: # double x, Chi, Shi, shichi(); ($flag, $Shi, $Chi) = shichi( $x ); DESCRIPTION: Approximates the integrals x - | | cosh t - 1 Chi(x) = eul + ln x + | ----------- dt, | | t - 0 x - | | sinh t Shi(x) = | ------ dt | | t - 0 where eul = 0.57721566490153286061 is Euler's constant. The integrals are evaluated by power series for x < 8 and by Chebyshev expansions for x between 8 and 88. For large x, both functions approach exp(x)/2x. Arguments greater than 88 in magnitude return MAXNUM. ACCURACY: Test interval 0 to 88. Relative error: arithmetic function # trials peak rms DEC Shi 3000 9.1e-17 IEEE Shi 30000 6.9e-16 1.6e-16 Absolute error, except relative when |Chi| > 1: DEC Chi 2500 9.3e-17 IEEE Chi 30000 8.4e-16 1.4e-16 =item I: Sine and cosine integrals SYNOPSIS: # double x, Ci, Si, sici(); ($flag, $Si, $Ci) = sici( $x ); DESCRIPTION: Evaluates the integrals x - | cos t - 1 Ci(x) = eul + ln x + | --------- dt, | t - 0 x - | sin t Si(x) = | ----- dt | t - 0 where eul = 0.57721566490153286061 is Euler's constant. The integrals are approximated by rational functions. For x > 8 auxiliary functions f(x) and g(x) are employed such that Ci(x) = f(x) sin(x) - g(x) cos(x) Si(x) = pi/2 - f(x) cos(x) - g(x) sin(x) ACCURACY: Test interval = [0,50]. Absolute error, except relative when > 1: arithmetic function # trials peak rms IEEE Si 30000 4.4e-16 7.3e-17 IEEE Ci 30000 6.9e-16 5.1e-17 DEC Si 5000 4.4e-17 9.0e-18 DEC Ci 5300 7.9e-17 5.2e-18 =item I: Circular sine SYNOPSIS: # double x, y, sin(); $y = sin( $x ); DESCRIPTION: Range reduction is into intervals of pi/4. The reduction error is nearly eliminated by contriving an extended precision modular arithmetic. Two polynomial approximating functions are employed. Between 0 and pi/4 the sine is approximated by x + x**3 P(x**2). Between pi/4 and pi/2 the cosine is represented as 1 - x**2 Q(x**2). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0, 10 150000 3.0e-17 7.8e-18 IEEE -1.07e9,+1.07e9 130000 2.1e-16 5.4e-17 ERROR MESSAGES: message condition value returned sin total loss x > 1.073741824e9 0.0 Partial loss of accuracy begins to occur at x = 2**30 = 1.074e9. The loss is not gradual, but jumps suddenly to about 1 part in 10e7. Results may be meaningless for x > 2**49 = 5.6e14. The routine as implemented flags a TLOSS error for x > 2**30 and returns 0.0. =item I: Circular cosine SYNOPSIS: # double x, y, cos(); $y = cos( $x ); DESCRIPTION: Range reduction is into intervals of pi/4. The reduction error is nearly eliminated by contriving an extended precision modular arithmetic. Two polynomial approximating functions are employed. Between 0 and pi/4 the cosine is approximated by 1 - x**2 Q(x**2). Between pi/4 and pi/2 the sine is represented as x + x**3 P(x**2). ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -1.07e9,+1.07e9 130000 2.1e-16 5.4e-17 DEC 0,+1.07e9 17000 3.0e-17 7.2e-18 =item I: Circular sine of angle in degrees SYNOPSIS: # double x, y, sindg(); $y = sindg( $x ); DESCRIPTION: Range reduction is into intervals of 45 degrees. Two polynomial approximating functions are employed. Between 0 and pi/4 the sine is approximated by x + x**3 P(x**2). Between pi/4 and pi/2 the cosine is represented as 1 - x**2 P(x**2). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC +-1000 3100 3.3e-17 9.0e-18 IEEE +-1000 30000 2.3e-16 5.6e-17 ERROR MESSAGES: message condition value returned sindg total loss x > 8.0e14 (DEC) 0.0 x > 1.0e14 (IEEE) =item I: Circular cosine of angle in degrees SYNOPSIS: # double x, y, cosdg(); $y = cosdg( $x ); DESCRIPTION: Range reduction is into intervals of 45 degrees. Two polynomial approximating functions are employed. Between 0 and pi/4 the cosine is approximated by 1 - x**2 P(x**2). Between pi/4 and pi/2 the sine is represented as x + x**3 P(x**2). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC +-1000 3400 3.5e-17 9.1e-18 IEEE +-1000 30000 2.1e-16 5.7e-17 See also sin(). =item I: Hyperbolic sine SYNOPSIS: # double x, y, sinh(); $y = sinh( $x ); DESCRIPTION: Returns hyperbolic sine of argument in the range MINLOG to MAXLOG. The range is partitioned into two segments. If |x| <= 1, a rational function of the form x + x**3 P(x)/Q(x) is employed. Otherwise the calculation is sinh(x) = ( exp(x) - exp(-x) )/2. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC +- 88 50000 4.0e-17 7.7e-18 IEEE +-MAXLOG 30000 2.6e-16 5.7e-17 =item I: Dilogarithm SYNOPSIS: # double x, y, spence(); $y = spence( $x ); DESCRIPTION: Computes the integral x - | | log t spence(x) = - | ----- dt | | t - 1 - 1 for x >= 0. A rational approximation gives the integral in the interval (0.5, 1.5). Transformation formulas for 1/x and 1-x are employed outside the basic expansion range. ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE 0,4 30000 3.9e-15 5.4e-16 DEC 0,4 3000 2.5e-16 4.5e-17 =item I: Square root SYNOPSIS: # double x, y, sqrt(); $y = sqrt( $x ); DESCRIPTION: Returns the square root of x. Range reduction involves isolating the power of two of the argument and using a polynomial approximation to obtain a rough value for the square root. Then Heron's iteration is used three times to converge to an accurate value. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0, 10 60000 2.1e-17 7.9e-18 IEEE 0,1.7e308 30000 1.7e-16 6.3e-17 ERROR MESSAGES: message condition value returned sqrt domain x < 0 0.0 =item I: Student's t distribution SYNOPSIS: # double t, stdtr(); short k; $y = stdtr( $k, $t ); DESCRIPTION: Computes the integral from minus infinity to t of the Student t distribution with integer k > 0 degrees of freedom: t - | | - | 2 -(k+1)/2 | ( (k+1)/2 ) | ( x ) ---------------------- | ( 1 + --- ) dx - | ( k ) sqrt( k pi ) | ( k/2 ) | | | - -inf. Relation to incomplete beta integral: 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) where z = k/(k + t**2). For t < -2, this is the method of computation. For higher t, a direct method is derived from integration by parts. Since the function is symmetric about t=0, the area under the right tail of the density is found by calling the function with -t instead of t. ACCURACY: Tested at random 1 <= k <= 25. The "domain" refers to t. Relative error: arithmetic domain # trials peak rms IEEE -100,-2 50000 5.9e-15 1.4e-15 IEEE -2,100 500000 2.7e-15 4.9e-17 =item I: Functional inverse of Student's t distribution SYNOPSIS: # double p, t, stdtri(); # int k; $t = stdtri( $k, $p ); DESCRIPTION: Given probability p, finds the argument t such that stdtr(k,t) is equal to p. ACCURACY: Tested at random 1 <= k <= 100. The "domain" refers to p: Relative error: arithmetic domain # trials peak rms IEEE .001,.999 25000 5.7e-15 8.0e-16 IEEE 10^-6,.001 25000 2.0e-12 2.9e-14 =item I: Struve function SYNOPSIS: # double v, x, y, struve(); $y = struve( $v, $x ); DESCRIPTION: Computes the Struve function Hv(x) of order v, argument x. Negative x is rejected unless v is an integer. ACCURACY: Not accurately characterized, but spot checked against tables. =item I: Integral of Planck's black body radiation formula SYNOPSIS: # double lambda, T, y, plancki() $y = plancki( $lambda, $T ); DESCRIPTION: Evaluates the definite integral, from wavelength 0 to lambda, of Planck's radiation formula -5 c1 lambda E = ------------------ c2/(lambda T) e - 1 Physical constants c1 = 3.7417749e-16 and c2 = 0.01438769 are built in to the function program. They are scaled to provide a result in watts per square meter. Argument T represents temperature in degrees Kelvin; lambda is wavelength in meters. The integral is expressed in closed form, in terms of polylogarithms (see polylog.c). The total area under the curve is (-1/8) (42 zeta(4) - 12 pi^2 zeta(2) + pi^4 ) c1 (T/c2)^4 = (pi^4 / 15) c1 (T/c2)^4 = 5.6705032e-8 T^4 where sigma = 5.6705032e-8 W m^2 K^-4 is the Stefan-Boltzmann constant. ACCURACY: The left tail of the function experiences some relative error amplification in computing the dominant term exp(-c2/(lambda T)). For the right-hand tail see planckc, below. Relative error. The domain refers to lambda T / c2. arithmetic domain # trials peak rms IEEE 0.1, 10 50000 7.1e-15 5.4e-16 =item I: polylogarithm function SYNOPSIS: # double x, y, polylog(); # int n; $y = polylog( $n, $x ); The polylogarithm of order n is defined by the series inf k - x Li (x) = > --- . n - n k=1 k For x = 1, inf - 1 Li (1) = > --- = Riemann zeta function (n) . n - n k=1 k When n = 2, the function is the dilogarithm, related to Spence's integral: x 1-x - - | | -ln(1-t) | | ln t Li (x) = | -------- dt = | ------ dt = spence(1-x) . 2 | | t | | 1 - t - - 0 1 ACCURACY: Relative error: arithmetic domain n # trials peak rms IEEE 0, 1 2 50000 6.2e-16 8.0e-17 IEEE 0, 1 3 100000 2.5e-16 6.6e-17 IEEE 0, 1 4 30000 1.7e-16 4.9e-17 IEEE 0, 1 5 30000 5.1e-16 7.8e-17 =item I: Bernoulli numbers SYNOPSIS: ($num, $den) = bernum( $n); ($num_array, $den_array) = bernum(); DESCRIPTION: This calculates the Bernoulli numbers, up to 30th order. If called with an integer argument, the numerator and denominator of that Bernoulli number is returned; if called with no argument, two array references representing the numerator and denominators of the first 30 Bernoulli numbers are returned. =item I: Simpson's rule to find an integral SYNOPSIS: $result = simpson(\&fun, $a, $b, $abs_err, $rel_err, $nmax); sub fun { my $x = shift; return cos($x)*exp($x); } DESCRIPTION: This evaluates the area under the graph of a function, represented in a subroutine, from $a to $b, using an 8-point Newton-Cotes formula. The routine divides up the interval into equal segments, evaluates the integral, then compares that to the result with double the number of segments. If the two results agree, to within an absolute error $abs_err or a relative error $rel_err, the result is returned; otherwise, the number of segments is doubled again, and the results compared. This continues until the desired accuracy is attained, or until the maximum number of iterations $nmax is reached. =item I: angle between two vectors SYNOPSIS: # double p[3], q[3], vecang(); $y = vecang( $p, $q ); DESCRIPTION: For two vectors p, q, the angle A between them is given by p.q / (|p| |q|) = cos A . where "." represents inner product, "|x|" the length of vector x. If the angle is small, an expression in sin A is preferred. Set r = q - p. Then p.q = p.p + p.r , |p|^2 = p.p , |q|^2 = p.p + 2 p.r + r.r , p.p^2 + 2 p.p p.r + p.r^2 cos^2 A = ---------------------------- p.p (p.p + 2 p.r + r.r) p.p + 2 p.r + p.r^2 / p.p = --------------------------- , p.p + 2 p.r + r.r sin^2 A = 1 - cos^2 A r.r - p.r^2 / p.p = -------------------- p.p + 2 p.r + r.r = (r.r - p.r^2 / p.p) / q.q . ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE -1, 1 10^6 1.7e-16 4.2e-17 =item I: Hypergeometric function 1F2 SYNOPSIS: # double a, b, c, x, value; # double *err; ($value, $err) = onef2( $a, $b, $c, $x) ACCURACY: Not accurately characterized, but spot checked against tables. =item I: Hypergeometric function 3F0 SYNOPSIS: # double a, b, c, x, value; # double *err; ($value, $err) = threef0( $a, $b, $c, $x ) ACCURACY: Not accurately characterized, but spot checked against tables. =item I: Bessel function Yv with noninteger v SYNOPSIS: # double v, x; # double yv( v, x ); $y = yv( $v, $x ); ACCURACY: Not accurately characterized, but spot checked against tables. =item I: Circular tangent SYNOPSIS: # double x, y, tan(); $y = tan( $x ); DESCRIPTION: Returns the circular tangent of the radian argument x. Range reduction is modulo pi/4. A rational function x + x**3 P(x**2)/Q(x**2) is employed in the basic interval [0, pi/4]. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC +-1.07e9 44000 4.1e-17 1.0e-17 IEEE +-1.07e9 30000 2.9e-16 8.1e-17 ERROR MESSAGES: message condition value returned tan total loss x > 1.073741824e9 0.0 =item I: Circular cotangent SYNOPSIS: # double x, y, cot(); $y = cot( $x ); DESCRIPTION: Returns the circular cotangent of the radian argument x. Range reduction is modulo pi/4. A rational function x + x**3 P(x**2)/Q(x**2) is employed in the basic interval [0, pi/4]. ACCURACY: Relative error: arithmetic domain # trials peak rms IEEE +-1.07e9 30000 2.9e-16 8.2e-17 ERROR MESSAGES: message condition value returned cot total loss x > 1.073741824e9 0.0 cot singularity x = 0 INFINITY =item I: Circular tangent of argument in degrees SYNOPSIS: # double x, y, tandg(); $y = tandg( $x ); DESCRIPTION: Returns the circular tangent of the argument x in degrees. Range reduction is modulo pi/4. A rational function x + x**3 P(x**2)/Q(x**2) is employed in the basic interval [0, pi/4]. ACCURACY: Relative error: arithmetic domain # trials peak rms DEC 0,10 8000 3.4e-17 1.2e-17 IEEE 0,10 30000 3.2e-16 8.4e-17 ERROR MESSAGES: message condition value returned tandg total loss x > 8.0e14 (DEC) 0.0 x > 1.0e14 (IEEE) tandg singularity x = 180 k + 90 MAXNUM =item I: Circular cotangent of argument in degrees SYNOPSIS: # double x, y, cotdg(); $y = cotdg( $x ); DESCRIPTION: Returns the circular cotangent of the argument x in degrees. Range reduction is modulo pi/4. A rational function x + x**3 P(x**2)/Q(x**2) is employed in the basic interval [0, pi/4]. ERROR MESSAGES: message condition value returned cotdg total loss x > 8.0e14 (DEC) 0.0 x > 1.0e14 (IEEE) cotdg singularity x = 180 k MAXNUM =item I: Hyperbolic tangent SYNOPSIS: # double x, y, tanh(); $y = tanh( $x ); DESCRIPTION: Returns hyperbolic tangent of argument in the range MINLOG to MAXLOG. A rational function is used for |x| < 0.625. The form x + x**3 P(x)/Q(x) of Cody _& Waite is employed. Otherwise, tanh(x) = sinh(x)/cosh(x) = 1 - 2/(exp(2x) + 1). ACCURACY: Relative error: arithmetic domain # trials peak rms DEC -2,2 50000 3.3e-17 6.4e-18 IEEE -2,2 30000 2.5e-16 5.8e-17 =item I: Relative error approximations for function arguments near unity. SYNOPSIS: # log1p(x) = log(1+x) $y = log1p( $x ); # expm1(x) = exp(x) - 1 $y = expm1( $x ); # cosm1(x) = cos(x) - 1 $y = cosm1( $x ); =item I: Bessel function of second kind of integer order SYNOPSIS: # double x, y, yn(); # int n; $y = yn( $n, $x ); DESCRIPTION: Returns Bessel function of order n, where n is a (possibly negative) integer. The function is evaluated by forward recurrence on n, starting with values computed by the routines y0() and y1(). If n = 0 or 1 the routine for y0 or y1 is called directly. ACCURACY: Absolute error, except relative when y > 1: arithmetic domain # trials peak rms DEC 0, 30 2200 2.9e-16 5.3e-17 IEEE 0, 30 30000 3.4e-15 4.3e-16 ERROR MESSAGES: message condition value returned yn singularity x = 0 MAXNUM yn overflow MAXNUM Spot checked against tables for x, n between 0 and 100. =item I: Riemann zeta function of two arguments SYNOPSIS: # double x, q, y, zeta(); $y = zeta( $x, $q ); DESCRIPTION: inf. - -x zeta(x,q) = > (k+q) - k=0 where x > 1 and q is not a negative integer or zero. The Euler-Maclaurin summation formula is used to obtain the expansion n - -x zeta(x,q) = > (k+q) - k=1 1-x inf. B x(x+1)...(x+2j) (n+q) 1 - 2j + --------- - ------- + > -------------------- x-1 x - x+2j+1 2(n+q) j=1 (2j)! (n+q) where the B2j are Bernoulli numbers. Note that (see zetac.c) zeta(x,1) = zetac(x) + 1. ACCURACY: REFERENCE: Gradshteyn, I. S., and I. M. Ryzhik, Tables of Integrals, Series, and Products, p. 1073; Academic Press, 1980. =item I: Riemann zeta function SYNOPSIS: # double x, y, zetac(); $y = zetac( $x ); DESCRIPTION: inf. - -x zetac(x) = > k , x > 1, - k=2 is related to the Riemann zeta function by Riemann zeta(x) = zetac(x) + 1. Extension of the function definition for x < 1 is implemented. Zero is returned for x > log2(MAXNUM). An overflow error may occur for large negative x, due to the gamma function in the reflection formula. ACCURACY: Tabulated values have full machine accuracy. Relative error: arithmetic domain # trials peak rms IEEE 1,50 10000 9.8e-16 1.3e-16 DEC 1,50 2000 1.1e-16 1.9e-17 =back =head1 TODO =over 4 =item * Include more operating systems when generating mconf.h. =back =head1 MAINTAINER Shlomi Fish, L, L . =head1 BUGS Please report any on the rt.cpan.org interface: L =head1 VERSION CONTROL This distribution is maintained in this GitHub repository: L. =head1 SEE ALSO For interfaces to programs which can do symbolic manipulation, see L, L, and L. For a command line interface to the routines of I, see the included C script. For a different interface to the fraction and complex number routines, see L and L. For an interface to some polynomial routines, see L, and for some matrix routines, see L. =head1 COPYRIGHT The C code for the Cephes Math Library is Copyright 1984, 1987, 1989, 2002 by Stephen L. Moshier, and is available at L. Direct inquiries to 30 Frost Street, Cambridge, MA 02140. The file arrays.c included here to handle passing arrays into and out of C routines comes from the PGPLOT module of Karl Glazebrook . The perl interface is copyright 2000, 2002 by Randy Kobes. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Perl interface maintained by Shlomi Fish starting from 2012. All explicit or implicit copyrights on the changes are disclaimed by him. =cut Math-Cephes-0.5306/lib/Math/Cephes.pm0000644000175000017500000002544314757250123017013 0ustar shlomifshlomif# This file was automatically generated by SWIG package Math::Cephes; use strict; use warnings; use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @ISA); require Exporter; *import = \&Exporter::import; require DynaLoader; @ISA = qw( DynaLoader); package Math::Cephesc; bootstrap Math::Cephes; package Math::Cephes; my @constants = qw($PI $PIO2 $PIO4 $SQRT2 $MACHEP $MAXLOG $MINLOG $MAXNUM $SQ2OPI $LOGE2 $LOGSQ2 $THPIO4 $TWOOPI $SQRTH $LOG2E ); my @trigs = qw(asin acos atan atan2 sin cos tan cot hypot tandg cotdg sindg cosdg radian cosm1); my @hypers = qw(acosh asinh atanh sinh cosh tanh); my @explog = qw(log1p expm1 exp exp10 exp2 log log10 log2 expxx); my @cmplx = qw(clog cexp csin ccos ctan ccot casin cacos catan cadd csub cmul cdiv cmov cneg cabs csqrt csinh ccosh ctanh cpow casinh cacosh catanh new_cmplx); my @utils = qw(ceil floor frexp ldexp fabs round sqrt lrand pow powi drand lsqrt fac cbrt); my @bessels = qw(i0 i0e i1 i1e iv j0 j1 jn jv k0 k1 kn yn yv k0e k1e y0 y1); my @dists = qw(bdtr bdtrc bdtri btdtr chdtr chdtrc chdtri fdtr fdtrc fdtri gdtr gdtrc nbdtr nbdtrc nbdtri ndtr ndtri pdtr pdtrc pdtri stdtr stdtri); my @gammas = qw(gamma igam igamc igami psi fac rgamma lgam); my @betas = qw(beta lbeta incbet incbi lbeta); my @elliptics = qw(ellie ellik ellpe ellpj ellpk); my @hypergeometrics = qw(onef2 threef0 hyp2f1 hyperg hyp2f0); my @misc = qw(zeta zetac airy dawsn fresnl sici shichi expn spence ei erfc erf struve plancki simpson bernum polylog vecang); my @fract = qw(radd rsub rmul rdiv euclid); %EXPORT_TAGS = ('constants' => [@constants], 'utils' => [@utils], 'trigs' => [@trigs], 'hypers' => [@hypers], 'explog' => [@explog], 'cmplx' => [@cmplx], 'bessels' => [@bessels], 'gammas' => [@gammas], 'dists' => [@dists], 'betas' => [@betas], 'elliptics' => [@elliptics], 'hypergeometrics' => [@hypergeometrics], 'fract' => [@fract], 'misc' => [@misc], 'all' => [@constants, @utils, @trigs, @hypers, @explog, @bessels, @gammas, @betas, @elliptics, @hypergeometrics, @misc, @dists], ); @EXPORT_OK = (@constants, @utils, @trigs, @hypers, @explog, @bessels, @gammas, @betas, @elliptics, @hypergeometrics, @misc, @dists, @fract, @cmplx); $VERSION = '0.5306'; #Math::Cephes->bootstrap($VERSION); #var_Math__Cephes_init(); sub simpson { my ($r, $a, $b, $abs, $rel, $nmax) = @_; die "Must supply a CODE reference" unless ref($r) eq 'CODE'; die "Must supply start and end points($a and $b)" unless (defined $a and defined $b); $abs ||= 1e-06; $rel ||= 1e-06; $nmax ||= 256; $nmax = 2 if $nmax < 2; my $sumold = 0; for (my $n=2; $n<=$nmax; $n++) { my $count = 0; my $x = $a; my $sum = 0; my $h = ($b - $a) / $n / 8; my $f = []; for($count=0; $count <= 8*$n; $count++, $x+=$h) { $f->[$count] = &$r($x); } $sum = Math::Cephes::simpsn_wrap($f, $count-1, $h); my $test = abs($sum - $sumold); return $sum if ($test < $abs or abs($test/$sum) < $rel); $sumold = $sum; } warn("Math::Cephes::simpson: Maximum number $nmax of iterations reached"); return undef; } sub bernum { my $i = shift; die "Cannot exceed i=30" if (defined $i and $i > 30); my $num = [split //, 0 x 30 ]; my $den = [split //, 0 x 30 ]; Math::Cephes::bernum_wrap($num, $den); return defined $i ? (int($num->[$i]), int($den->[$i])) : ($num, $den); } sub expxx { my $x = shift; my $n = shift || 1; return Math::Cephes::expx2($x, $n); } sub vecang { my ($a, $b) = @_; die "Must supply array references" unless (ref($a) eq 'ARRAY' and ref($b) eq 'ARRAY'); die "Vectors must be of dimension 3" unless (scalar @$a == 3 and scalar @$b == 3); return Math::Cephes::arcdot($a, $b); } # ---------- BASE METHODS ------------- package Math::Cephes; sub TIEHASH { my ($classname,$obj) = @_; return bless $obj, $classname; } sub CLEAR { } sub FIRSTKEY { } sub NEXTKEY { } sub FETCH { my ($self,$field) = @_; my $member_func = "swig_${field}_get"; $self->$member_func(); } sub STORE { my ($self,$field,$newval) = @_; my $member_func = "swig_${field}_set"; $self->$member_func($newval); } sub this { my $ptr = shift; return tied(%$ptr); } # ------- FUNCTION WRAPPERS -------- package Math::Cephes; *acosh = *Math::Cephesc::md_acosh; *airy = *Math::Cephesc::airy; *asin = *Math::Cephesc::md_asin; *acos = *Math::Cephesc::md_acos; *asinh = *Math::Cephesc::md_asinh; *atan = *Math::Cephesc::md_atan; *atan2 = *Math::Cephesc::md_atan2; *atanh = *Math::Cephesc::md_atanh; *bdtrc = *Math::Cephesc::bdtrc; *bdtr = *Math::Cephesc::bdtr; *bdtri = *Math::Cephesc::bdtri; *beta = *Math::Cephesc::beta; *lbeta = *Math::Cephesc::lbeta; *btdtr = *Math::Cephesc::btdtr; *cbrt = *Math::Cephesc::md_cbrt; *chbevl = *Math::Cephesc::chbevl; *chdtrc = *Math::Cephesc::chdtrc; *chdtr = *Math::Cephesc::chdtr; *chdtri = *Math::Cephesc::chdtri; *clog = *Math::Cephesc::md_clog; *cexp = *Math::Cephesc::md_cexp; *csin = *Math::Cephesc::md_csin; *ccos = *Math::Cephesc::md_ccos; *ctan = *Math::Cephesc::md_ctan; *ccot = *Math::Cephesc::ccot; *casin = *Math::Cephesc::md_casin; *cacos = *Math::Cephesc::md_cacos; *catan = *Math::Cephesc::md_catan; *csinh = *Math::Cephesc::md_csinh; *casinh = *Math::Cephesc::md_casinh; *ccosh = *Math::Cephesc::md_ccosh; *cacosh = *Math::Cephesc::md_cacosh; *ctanh = *Math::Cephesc::md_ctanh; *catanh = *Math::Cephesc::md_catanh; *cpow = *Math::Cephesc::md_cpow; *radd = *Math::Cephesc::radd; *rsub = *Math::Cephesc::rsub; *rmul = *Math::Cephesc::rmul; *rdiv = *Math::Cephesc::rdiv; *euclid = *Math::Cephesc::euclid; *cadd = *Math::Cephesc::cadd; *csub = *Math::Cephesc::csub; *cmul = *Math::Cephesc::cmul; *cdiv = *Math::Cephesc::cdiv; *cmov = *Math::Cephesc::cmov; *cneg = *Math::Cephesc::cneg; *cabs = *Math::Cephesc::md_cabs; *csqrt = *Math::Cephesc::md_csqrt; *hypot = *Math::Cephesc::md_hypot; *cosh = *Math::Cephesc::md_cosh; *dawsn = *Math::Cephesc::dawsn; *ellie = *Math::Cephesc::ellie; *ellik = *Math::Cephesc::ellik; *ellpe = *Math::Cephesc::ellpe; *ellpj = *Math::Cephesc::ellpj; *ellpk = *Math::Cephesc::ellpk; *exp = *Math::Cephesc::md_exp; *exp10 = *Math::Cephesc::md_exp10; *exp2 = *Math::Cephesc::md_exp2; *expn = *Math::Cephesc::md_expn; *ei = *Math::Cephesc::ei; *fabs = *Math::Cephesc::md_fabs; *fac = *Math::Cephesc::fac; *fdtrc = *Math::Cephesc::fdtrc; *fdtr = *Math::Cephesc::fdtr; *fdtri = *Math::Cephesc::fdtri; *ceil = *Math::Cephesc::md_ceil; *floor = *Math::Cephesc::md_floor; *frexp = *Math::Cephesc::md_frexp; *ldexp = *Math::Cephesc::md_ldexp; *fresnl = *Math::Cephesc::fresnl; *gamma = *Math::Cephesc::md_gamma; *lgam = *Math::Cephesc::lgam; *gdtr = *Math::Cephesc::gdtr; *gdtrc = *Math::Cephesc::gdtrc; *hyp2f1 = *Math::Cephesc::hyp2f1; *hyperg = *Math::Cephesc::hyperg; *hyp2f0 = *Math::Cephesc::hyp2f0; *i0 = *Math::Cephesc::i0; *i0e = *Math::Cephesc::i0e; *i1 = *Math::Cephesc::i1; *i1e = *Math::Cephesc::i1e; *igamc = *Math::Cephesc::igamc; *igam = *Math::Cephesc::igam; *igami = *Math::Cephesc::igami; *incbet = *Math::Cephesc::incbet; *incbi = *Math::Cephesc::incbi; *iv = *Math::Cephesc::iv; *j0 = *Math::Cephesc::md_j0; *y0 = *Math::Cephesc::md_y0; *j1 = *Math::Cephesc::md_j1; *y1 = *Math::Cephesc::md_y1; *jn = *Math::Cephesc::md_jn; *jv = *Math::Cephesc::jv; *k0 = *Math::Cephesc::k0; *k0e = *Math::Cephesc::k0e; *k1 = *Math::Cephesc::k1; *k1e = *Math::Cephesc::k1e; *kn = *Math::Cephesc::kn; *log = *Math::Cephesc::md_log; *log10 = *Math::Cephesc::md_log10; *log2 = *Math::Cephesc::md_log2; *lrand = *Math::Cephesc::lrand; *lsqrt = *Math::Cephesc::lsqrt; *mtherr = *Math::Cephesc::mtherr; *new_cmplx = \&Math::Cephesc::new_cmplx; *polevl = *Math::Cephesc::polevl; *p1evl = *Math::Cephesc::p1evl; *nbdtrc = *Math::Cephesc::nbdtrc; *nbdtr = *Math::Cephesc::nbdtr; *nbdtri = *Math::Cephesc::nbdtri; *ndtr = *Math::Cephesc::ndtr; *erfc = *Math::Cephesc::md_erfc; *erf = *Math::Cephesc::md_erf; *ndtri = *Math::Cephesc::ndtri; *pdtrc = *Math::Cephesc::pdtrc; *pdtr = *Math::Cephesc::pdtr; *pdtri = *Math::Cephesc::pdtri; *pow = *Math::Cephesc::md_pow; *powi = *Math::Cephesc::md_powi; *psi = *Math::Cephesc::psi; *rgamma = *Math::Cephesc::rgamma; *round = *Math::Cephesc::md_round; *shichi = *Math::Cephesc::shichi; *sici = *Math::Cephesc::sici; *sin = *Math::Cephesc::md_sin; *cos = *Math::Cephesc::md_cos; *radian = *Math::Cephesc::radian; *sindg = *Math::Cephesc::md_sindg; *cosdg = *Math::Cephesc::cosdg; *sinh = *Math::Cephesc::md_sinh; *spence = *Math::Cephesc::spence; *sqrt = *Math::Cephesc::sqrt; *stdtr = *Math::Cephesc::stdtr; *stdtri = *Math::Cephesc::stdtri; *onef2 = *Math::Cephesc::onef2; *threef0 = *Math::Cephesc::threef0; *struve = *Math::Cephesc::struve; *tan = *Math::Cephesc::md_tan; *cot = *Math::Cephesc::cot; *tandg = *Math::Cephesc::tandg; *cotdg = *Math::Cephesc::cotdg; *tanh = *Math::Cephesc::md_tanh; *log1p = *Math::Cephesc::md_log1p; *expm1 = *Math::Cephesc::expm1; *cosm1 = *Math::Cephesc::cosm1; *yn = *Math::Cephesc::md_yn; *yv = *Math::Cephesc::yv; *zeta = *Math::Cephesc::zeta; *zetac = *Math::Cephesc::zetac; *drand = *Math::Cephesc::drand; *plancki = *Math::Cephesc::plancki; *polini = *Math::Cephesc::polini; *polmul = *Math::Cephesc::polmul; *poldiv = *Math::Cephesc::poldiv; *poladd = *Math::Cephesc::poladd; *polsub = *Math::Cephesc::polsub; *polsbt = *Math::Cephesc::polsbt; *poleva = *Math::Cephesc::poleva; *polatn = *Math::Cephesc::polatn; *polsqt = *Math::Cephesc::polsqt; *polsin = *Math::Cephesc::polsin; *polcos = *Math::Cephesc::polcos; *polrt_wrap = *Math::Cephesc::polrt_wrap; *cpmul_wrap = *Math::Cephesc::cpmul_wrap; *fpolini = *Math::Cephesc::fpolini; *fpolmul_wrap = *Math::Cephesc::fpolmul_wrap; *fpoldiv_wrap = *Math::Cephesc::fpoldiv_wrap; *fpoladd_wrap = *Math::Cephesc::fpoladd_wrap; *fpolsub_wrap = *Math::Cephesc::fpolsub_wrap; *fpolsbt_wrap = *Math::Cephesc::fpolsbt_wrap; *fpoleva_wrap = *Math::Cephesc::fpoleva_wrap; *bernum_wrap = *Math::Cephesc::bernum_wrap; *simpsn_wrap = *Math::Cephesc::simpsn_wrap; *minv = *Math::Cephesc::minv; *mtransp = *Math::Cephesc::mtransp; *eigens = *Math::Cephesc::eigens; *simq = *Math::Cephesc::simq; *polylog = *Math::Cephesc::polylog; *arcdot = *Math::Cephesc::arcdot; *expx2 = *Math::Cephesc::expx2; # ------- VARIABLE STUBS -------- package Math::Cephes; *MACHEP = *Math::Cephesc::MACHEP; *MAXLOG = *Math::Cephesc::MAXLOG; *MINLOG = *Math::Cephesc::MINLOG; *MAXNUM = *Math::Cephesc::MAXNUM; *PI = *Math::Cephesc::PI; *PIO2 = *Math::Cephesc::PIO2; *PIO4 = *Math::Cephesc::PIO4; *SQRT2 = *Math::Cephesc::SQRT2; *SQRTH = *Math::Cephesc::SQRTH; *LOG2E = *Math::Cephesc::LOG2E; *SQ2OPI = *Math::Cephesc::SQ2OPI; *LOGE2 = *Math::Cephesc::LOGE2; *LOGSQ2 = *Math::Cephesc::LOGSQ2; *THPIO4 = *Math::Cephesc::THPIO4; *TWOOPI = *Math::Cephesc::TWOOPI; require Math::Cephes::Complex; 1; __END__ Math-Cephes-0.5306/lib/Math/Cephes/0000755000175000017500000000000014757250372016453 5ustar shlomifshlomifMath-Cephes-0.5306/lib/Math/Cephes/Fraction.pm0000644000175000017500000001441314757250123020553 0ustar shlomifshlomif############# Class : fract ############## package Math::Cephes::Fraction; use strict; use warnings; use vars qw(%OWNER @ISA %ITERATORS @EXPORT_OK %EXPORT_TAGS $VERSION); require Exporter; *import = \&Exporter::import; #my @fract = qw(radd rsub rmul rdiv euclid fract mixed_fract); my @fract = qw(euclid fract mixed_fract); @EXPORT_OK = (@fract); %EXPORT_TAGS = ('fract' => [@fract]); $VERSION = '0.5306'; #use Math::Cephes qw(new_fract euclid); require Math::Cephes; @ISA = qw( Math::Cephes ); %OWNER = (); %ITERATORS = (); *swig_n_get = *Math::Cephesc::fract_n_get; *swig_n_set = *Math::Cephesc::fract_n_set; *swig_d_get = *Math::Cephesc::fract_d_get; *swig_d_set = *Math::Cephesc::fract_d_set; sub new { my $pkg = shift; my $self = Math::Cephesc::new_fract(@_); bless $self, $pkg if defined($self); } sub DESTROY { return unless $_[0]->isa('HASH'); my $self = tied(%{$_[0]}); return unless defined $self; delete $ITERATORS{$self}; if (exists $OWNER{$self}) { Math::Cephesc::delete_fract($self); delete $OWNER{$self}; } } sub DISOWN { my $self = shift; my $ptr = tied(%$self); delete $OWNER{$ptr}; } sub ACQUIRE { my $self = shift; my $ptr = tied(%$self); $OWNER{$ptr} = 1; } sub fract { return Math::Cephes::Fraction->new(@_); } sub n { my ($self, $value) = @_; return $self->{n} unless $value; $self->{n} = $value; return $value; } sub d { my ($self, $value) = @_; return $self->{d} unless $value; $self->{d} = $value; return $value; } sub euclid { return Math::Cephes::euclid($_[0], $_[1]); } sub mixed_fract { my $f = shift; my $nin = int($f->{n}); my $din = int($f->{d}); my $gcd; if ($din < 0) { $din *= -1; $nin *= -1; } if (abs($nin) < abs($din)) { if ( $nin == 0 ) { return (0, 0, 0); } else { ($gcd, $nin, $din) = euclid($nin, $din); return (0, $nin, $din); } } else { my $n = abs($nin) % $din; my $w = int($nin / $din); if ($n == 0) { return ($w, 0, 1); } else { ($gcd, $n, $din) = euclid($n, $din); return ($w, $n, $din); } } } sub as_string { my $f = shift; my ($gcd, $string); my $num = int($f->{n}); my $den = int($f->{d}); if ( abs($num % $den) == 0) { my $w = $num / $den; $string = "$w"; } elsif ($num == 0) { $string = '0'; } else { if ($den < 0) { $num *= -1; $den *= -1; } ($gcd, $num, $den) = euclid($num, $den); $string = "$num/$den"; } return $string; } sub as_mixed_string { my $f = shift; my ($gcd, $string); my $num = int($f->{n}); my $den = int($f->{d}); if ($den < 0) { $den *= -1; $num *= -1; } if (abs($num) < abs($den)) { if ( $num == 0 ) { $string = '0'; } else { ($gcd, $num, $den) = euclid($num, $den); $string = "$num/$den"; } } else { my $n = abs($num) % $den; my $w = int($num / $den); if ($n == 0) { $string = "$w"; } else { ($gcd, $num, $den) = euclid($num, $den); $string = "$w $n/$den"; } } return $string; } sub radd { my ($f1, $f2) = @_; my $f = Math::Cephes::Fraction->new(); Math::Cephes::radd($f1, $f2, $f); return $f; } sub rsub { my ($f1, $f2) = @_; my $f = Math::Cephes::Fraction->new(); Math::Cephes::rsub($f2, $f1, $f); return $f; } sub rmul { my ($f1, $f2) = @_; my $f = Math::Cephes::Fraction->new(); Math::Cephes::rmul($f1, $f2, $f); return $f; } sub rdiv { my ($f1, $f2) = @_; my $f = Math::Cephes::Fraction->new(); Math::Cephes::rdiv($f2, $f1, $f); return $f; } 1; __END__ =head1 NAME Math::Cephes::Fraction - Perl interface to the cephes math fraction routines =head1 SYNOPSIS use Math::Cephes::Fraction qw(fract); my $f1 = fract(2,3); # $f1 = 2/3 my $f2 = fract(3,4); # $f2 = 3/4 my $f3 = $f1->radd($f2); # $f3 = $f1 + $f2 =head1 DESCRIPTION This module is a layer on top of the basic routines in the cephes math library to handle fractions. A fraction object is created via any of the following syntaxes: my $f = Math::Cephes::Fraction->new(3, 2); # $f = 3/2 my $g = new Math::Cephes::Fraction(5, 3); # $g = 5/3 my $h = fract(7, 5); # $h = 7/5 the last one being available by importing I<:fract>. If no arguments are specified, as in my $h = fract(); then the defaults $z = 0/1 are assumed. The numerator and denominator of a fraction are represented respectively by $f->{n}; $f->{d} or, as methods, $f->n; $f->d; and can be set according to $f->{n} = 4; $f->{d} = 9; or, again, as methods, $f->n(4) ; $f->(d) = 9; The fraction can be printed out as print $f->as_string; or as a mixed fraction as print $f->as_mixed_string; These routines reduce the fraction to its basic form before printing. This uses the I routine which finds the greatest common divisor of two numbers, as follows: ($gcd, $m_reduced, $n_reduced) = euclid($m, $n); which returns the greatest common divisor of $m and $n, as well as the result of reducing $m and $n by $gcd A summary of the basic routines is as follows. $x = fract(3, 4); # x = 3 / 4 $y = fract(2, 3); # y = 2 / 3 $z = $x->radd( $y ); # z = x + y $z = $x->rsub( $y ); # z = x - y $z = $x->rmul( $y ); # z = x * y $z = $x->rdiv( $y ); # z = x / y print $z->{n}, ' ', $z->{d}; # prints numerator and denominator of $z print $z->as_string; # prints the fraction $z print $z->as_mixed_string; # converts $z to a mixed fraction, then prints it $m = 60; $n = 144; ($gcd, $m_reduced, $n_reduced) = euclid($m, $n); =head1 BUGS Please report any to Randy Kobes =head1 SEE ALSO For the basic interface to the cephes fraction routines, see L. See also L for a more extensive interface to fraction routines. =head1 COPYRIGHT The C code for the Cephes Math Library is Copyright 1984, 1987, 1989, 2002 by Stephen L. Moshier, and is available at http://www.netlib.org/cephes/. Direct inquiries to 30 Frost Street, Cambridge, MA 02140. The perl interface is copyright 2000, 2002 by Randy Kobes. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Cephes-0.5306/lib/Math/Cephes/Matrix.pm0000644000175000017500000002241214757250123020250 0ustar shlomifshlomifpackage Math::Cephes::Matrix; use strict; use warnings; use vars qw(@EXPORT_OK $VERSION); require Exporter; *import = \&Exporter::import; @EXPORT_OK = qw(mat); $VERSION = '0.5306'; require Math::Cephes; sub new { my ($caller, $arr) = @_; my $refer = ref($caller); my $class = $refer || $caller; die "Must supply data for the matrix" unless ($refer or $arr); unless ($refer) { die "Please supply an array of arrays for the matrix data" unless (ref($arr) eq 'ARRAY' and ref($arr->[0]) eq 'ARRAY'); my $n = scalar @$arr; my $m = scalar @{$arr->[0]}; die "Matrices must be square" unless $m == $n; } my ($coef, $n); if ($refer) { $n = $caller->{n}; my $cdata = $caller->{coef}; foreach (@$cdata) { push @$coef, [ @$_]; } } else { ($coef, $n) = ($arr, scalar @$arr); } bless { coef => $coef, n => $n, }, $class; } sub mat { return Math::Cephes::Matrix->new(shift); } sub mat_to_vec { my $self = shift; my ($M, $n) = ($self->{coef}, $self->{n}); my $A = []; for (my $i=0; $i<$n; $i++) { for (my $j=0; $j<$n; $j++) { my $index = $i*$n+$j; $A->[$index] = $M->[$i]->[$j]; } } return $A; } sub vec_to_mat { my ($self, $X) = @_; my $n = $self->{n}; my $I = []; for (my $i=0; $i<$n; $i++) { for (my $j=0; $j<$n; $j++) { my $index = $i*$n+$j; $I->[$i]->[$j] = $X->[$index]; } } return $I; } sub check { my ($self, $B) = @_; my $na = $self->{n}; my $ref = ref($B); if ($ref eq 'Math::Cephes::Matrix') { die "Matrices must be of the same size" unless $B->{n} == $na; return $B->coef; } elsif ($ref eq 'ARRAY') { my $nb = scalar @$B; my $ref0 = ref($B->[0]); if ($ref0 eq 'ARRAY') { my $m = scalar @{$B->[0]}; die "Can only use square matrices" unless $m == $nb; die "Can only use matrices of the same size" unless $na == $nb; return $B; } elsif (not $ref0) { die "Can only use vectors of the same size" unless $nb == $na; return $B; } else { die "Unknown reference '$ref0' for data"; } } else { die "Unknown reference '$ref' for data"; } } sub coef { return $_[0]->{coef}; } sub clr { my $self = shift; my $what = shift || 0; my $n = $self->{n}; my $B = []; for (my $i=0; $i<$n; $i++) { for (my $j=0; $j<$n; $j++) { $B->[$i]->[$j] = $what; } } $self->{coef} = $B; } sub simq { my ($self, $B) = @_; $B = $self->check($B); my ($M, $n) = ($self->{coef}, $self->{n}); die "Must supply an array reference for B" unless ref($B) eq 'ARRAY'; my $A = $self->mat_to_vec(); my $X = [split //, 0 x $n]; my $IPS = [split //, 0 x $n]; my $flag = 0; my $ret = Math::Cephes::simq($A, $B, $X, $n, $flag, $IPS); return $ret ? undef : $X; } sub inv { my $self = shift; my ($M, $n) = ($self->{coef}, $self->{n}); my $A = $self->mat_to_vec(); my $X = [split //, 0 x ($n*$n)]; my $B = [split //, 0 x $n]; my $IPS = [split //, 0 x $n]; my $flag = 0; my $ret = Math::Cephes::minv($A, $X, $n, $B, $IPS); return undef if $ret; my $I = $self->vec_to_mat($X); return Math::Cephes::Matrix->new($I); } sub transp { my $self = shift; my ($M, $n) = ($self->{coef}, $self->{n}); my $A = $self->mat_to_vec(); my $T = [split //, 0 x ($n*$n)]; Math::Cephes::mtransp($n, $A, $T); my $R = $self->vec_to_mat($T); return Math::Cephes::Matrix->new($R); } sub add { my ($self, $B) = @_; $B = $self->check($B); my ($A, $n) = ($self->{coef}, $self->{n}); my $C = []; for (my $i=0; $i<$n; $i++) { for (my $j=0; $j<$n; $j++) { $C->[$i]->[$j] = $A->[$i]->[$j] + $B->[$i]->[$j]; } } return Math::Cephes::Matrix->new($C); } sub sub { my ($self, $B) = @_; $B = $self->check($B); my ($A, $n) = ($self->{coef}, $self->{n}); my $C = []; for (my $i=0; $i<$n; $i++) { for (my $j=0; $j<$n; $j++) { $C->[$i]->[$j] = $A->[$i]->[$j] - $B->[$i]->[$j]; } } return Math::Cephes::Matrix->new($C); } sub mul { my ($self, $B) = @_; $B = $self->check($B); my ($A, $n) = ($self->{coef}, $self->{n}); my $C = []; if (ref($B->[0]) eq 'ARRAY') { for (my $i=0; $i<$n; $i++) { for (my $j=0; $j<$n; $j++) { for (my $m=0; $m<$n; $m++) { $C->[$i]->[$j] += $A->[$i]->[$m] * $B->[$m]->[$j]; } } } return Math::Cephes::Matrix->new($C); } else { for (my $i=0; $i<$n; $i++) { for (my $m=0; $m<$n; $m++) { $C->[$i] += $A->[$i]->[$m] * $B->[$m]; } } return $C; } } sub div { my ($self, $B) = @_; $B = $self->check($B); my $C = Math::Cephes::Matrix->new($B)->inv(); my $D = $self->mul($C); return $D; } sub eigens { my $self = shift; my ($M, $n) = ($self->{coef}, $self->{n}); my $A = []; for (my $i=0; $i<$n; $i++) { for (my $j=0; $j<$n; $j++) { my $index = ($i*$i+$i)/2 + $j; $A->[$index] = $M->[$i]->[$j]; } } my $EV1 = [split //, 0 x ($n*$n)]; my $E = [split //, 0 x $n]; my $IPS = [split //, 0 x $n]; Math::Cephes::eigens($A, $EV1, $E, $n); my $EV = $self->vec_to_mat($EV1); return ($E, Math::Cephes::Matrix->new($EV)); } 1; __END__ =head1 NAME Math::Cephes::Matrix - Perl interface to the cephes matrix routines =head1 SYNOPSIS use Math::Cephes::Matrix qw(mat); # 'mat' is a shortcut for Math::Cephes::Matrix->new my $M = mat([ [1, 2, -1], [2, -3, 1], [1, 0, 3]]); my $C = mat([ [1, 2, 4], [2, 9, 2], [6, 2, 7]]); my $D = $M->add($C); # D = M + C my $Dc = $D->coef; for (my $i=0; $i<3; $i++) { print "row $i:\n"; for (my $j=0; $j<3; $j++) { print "\tcolumn $j: $Dc->[$i]->[$j]\n"; } } =head1 DESCRIPTION This module is a layer on top of the basic routines in the cephes math library for operations on square matrices. In the following, a Math::Cephes::Matrix object is created as my $M = Math::Cephes::Matrix->new($arr_ref); where C<$arr_ref> is a reference to an array of arrays, as in the following example: $arr_ref = [ [1, 2, -1], [2, -3, 1], [1, 0, 3] ] which represents / 1 2 -1 \ | 2 -3 1 | \ 1 0 3 / A copy of a I object may be done as my $M_copy = $M->new(); =head2 Methods =over 4 =item I: get coefficients of the matrix SYNOPSIS: my $c = $M->coef; DESCRIPTION: This returns an reference to an array of arrays containing the coefficients of the matrix. =item I: set all coefficients equal to a value. SYNOPSIS: $M->clr($n); DESCRIPTION: This sets all the coefficients of the matrix identically to I<$n>. If I<$n> is not given, a default of 0 is used. =item I: add two matrices SYNOPSIS: $P = $M->add($N); DESCRIPTION: This sets $P equal to $M + $N. =item I: subtract two matrices SYNOPSIS: $P = $M->sub($N); DESCRIPTION: This sets $P equal to $M - $N. =item I: multiply two matrices or a matrix and a vector SYNOPSIS: $P = $M->mul($N); DESCRIPTION: This sets $P equal to $M * $N. This method can handle matrix multiplication, when $N is a matrix, as well as matrix-vector multiplication, where $N is an array reference representing a column vector. =item I
: divide two matrices SYNOPSIS: $P = $M->div($N); DESCRIPTION: This sets $P equal to $M * ($N)^(-1). =item I: invert a matrix SYNOPSIS: $I = $M->inv(); DESCRIPTION: This sets $I equal to ($M)^(-1). =item I: transpose a matrix SYNOPSIS: $T = $M->transp(); DESCRIPTION: This sets $T equal to the transpose of $M. =item I: solve simultaneous equations SYNOPSIS: my $M = Math::Cephes::Matrix->new([ [1, 2, -1], [2, -3, 1], [1, 0, 3]]); my $B = [2, -1, 10]; my $X = $M->simq($B); for (my $i=0; $i<3; $i++) { print "X[$i] is $X->[$i]\n"; } where $M is a I object, $B is an input array reference, and $X is an output array reference. DESCRIPTION: A set of N simultaneous equations may be represented in matrix form as M X = B where M is an N x N square matrix and X and B are column vectors of length N. =item I: eigenvalues and eigenvectors of a real symmetric matrix SYNOPSIS: my $S = Math::Cephes::Matrix->new([ [1, 2, 3], [2, 2, 3], [3, 3, 4]]); my ($E, $EV1) = $S->eigens(); my $EV = $EV1->coef; for (my $i=0; $i<3; $i++) { print "For i=$i, with eigenvalue $E->[$i]\n"; my $v = []; for (my $j=0; $j<3; $j++) { $v->[$j] = $EV->[$i]->[$j]; } print "The eigenvector is @$v\n"; } where $M is a I object representing a real symmetric matrix. $E is an array reference containing the eigenvalues of $M, and $EV is a I object representing the eigenvalues, the I row corresponding to the I eigenvalue. DESCRIPTION: If M is an N x N real symmetric matrix, and X is an N component column vector, the eigenvalue problem M X = lambda X will in general have N solutions, with X the eigenvectors and lambda the eigenvalues. =back =head1 BUGS Please report any to Randy Kobes =head1 COPYRIGHT The C code for the Cephes Math Library is Copyright 1984, 1987, 1989, 2002 by Stephen L. Moshier, and is available at http://www.netlib.org/cephes/. Direct inquiries to 30 Frost Street, Cambridge, MA 02140. The perl interface is copyright 2000, 2002 by Randy Kobes. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Cephes-0.5306/lib/Math/Cephes/Polynomial.pm0000644000175000017500000005572314757250123021142 0ustar shlomifshlomifpackage Math::Cephes::Polynomial; use strict; use warnings; use vars qw(@EXPORT_OK $VERSION $MAXPOL $FMAXPOL $flag $fflag); eval {require Math::Complex; import Math::Complex qw(Re Im)}; eval {local $^W=0; require Math::Fraction;}; $MAXPOL = 256; $flag = 0; $FMAXPOL = 256; $fflag = 0; require Exporter; *import = \&Exporter::import; @EXPORT_OK = qw(poly); $VERSION = '0.5306'; require Math::Cephes; require Math::Cephes::Fraction; require Math::Cephes::Complex; sub new { my ($caller, $arr) = @_; my $refer = ref($caller); my $class = $refer || $caller; die "Must supply data for the polynomial" unless ($refer or $arr); my ($type, $ref, $data, $n); if ($refer) { ($type, $ref, $n) = ($caller->{type}, $caller->{ref}, $caller->{n}); my $cdata = $caller->{data}; if (ref($cdata) eq 'ARRAY') { $data = [ @$cdata ]; } else { my ($f, $s) = ($type eq 'fract') ? ('n', 'd') : ('r', 'i'); $data = {$f => [ @{$cdata->{$f}} ], $s => [ @{$cdata->{$s}} ], }; } } else { ($type, $ref, $data, $n) = get_data($arr); } bless { type => $type, ref => $ref, data => $data, n => $n, }, $class; } sub poly { return Math::Cephes::Polynomial->new(shift); } sub coef { return $_[0]->{data}; } sub get_data { my ($arr, $ref_in) = @_; die "Must supply an array reference" unless ref($arr) eq 'ARRAY'; my $n = scalar @$arr - 1; my $ref = ref($arr->[0]); die "array data must be of type '$ref_in'" if (defined $ref_in and $ref_in ne $ref); my ($type, $data); SWITCH: { not $ref and do { $type = 'scalar'; foreach (@$arr) { die 'Found conflicting types in array data' if ref($_); } $data = $arr; set_max() unless $flag; last SWITCH; }; $ref eq 'Math::Cephes::Complex' and do { $type = 'cmplx'; foreach (@$arr) { die 'Found conflicting types in array data' unless ref($_) eq $ref; die "array data must be of type '$ref_in'" if (defined $ref_in and $ref_in ne $ref); push @{$data->{r}}, $_->r; push @{$data->{i}}, $_->i; } set_max() unless $flag; last SWITCH; }; $ref eq 'Math::Complex' and do { $type = 'cmplx'; foreach (@$arr) { die 'Found conflicting types in array data' unless ref($_) eq $ref; die "array data must be of type '$ref_in'" if (defined $ref_in and $ref_in ne $ref); push @{$data->{r}}, Re($_); push @{$data->{i}}, Im($_); } set_max() unless $flag; last SWITCH; }; $ref eq 'Math::Cephes::Fraction' and do { $type = 'fract'; foreach (@$arr) { die 'Found conflicting types in array data' unless ref($_) eq $ref; die "array data must be of type '$ref_in'" if (defined $ref_in and $ref_in ne $ref); my ($gcd, $n, $d) = Math::Cephes::euclid($_->n, $_->d); push @{$data->{n}}, $n; push @{$data->{d}}, $d; } set_fmax() unless $fflag; last SWITCH; }; $ref eq 'Math::Fraction' and do { $type = 'fract'; foreach (@$arr) { die 'Found conflicting types in array data' unless ref($_) eq $ref; die "array data must be of type '$ref_in'" if (defined $ref_in and $ref_in ne $ref); push @{$data->{n}}, $_->{frac}->[0]; push @{$data->{d}}, $_->{frac}->[1]; } set_fmax() unless $fflag; last SWITCH; }; die "Unknown type '$ref' in array data"; } return ($type, $ref, $data, $n); } sub as_string { my $self = shift; my ($type, $data, $n) = ($self->{type}, $self->{data}, $self->{n}); my $d = shift || $n; $d = $n if $d > $n; my $string; for (my $j=0; $j<=$d; $j++) { my $coef; SWITCH: { $type eq 'fract' and do { my $n = $data->{n}->[$j]; my $d = $data->{d}->[$j]; my $sgn = $n < 0 ? ' -' : ' +'; $coef = $sgn . ($j == 0? '(' : ' (') . abs($n) . '/' . abs($d) . ')'; last SWITCH; }; $type eq 'cmplx' and do { my $re = $data->{r}->[$j]; my $im = $data->{i}->[$j]; my $sgn = $j == 0 ? ' ' : ' + '; $coef = $sgn . '(' . $re . ( (int( $im / abs($im) ) == -1) ? '-' : '+' ) . ( ($im < 0) ? abs($im) : $im) . 'I)'; last SWITCH; }; my $f = $data->[$j]; my $sgn = $f < 0 ? ' -' : ' +'; $coef = $j == 0 ? ' ' . $f : $sgn . ' ' . abs($f); } $string .= $coef . ($j > 0 ? "x^$j" : ''); } return $string . "\n"; } sub add { my ($self, $b) = @_; my ($atype, $aref, $adata, $na) = ($self->{type}, $self->{ref}, $self->{data}, $self->{n}); my ($btype, $bref, $bdata, $nb) = ref($b) eq 'Math::Cephes::Polynomial' ? ($b->{type}, $b->{ref}, $b->{data}, $b->{n}) : get_data($b, $aref); my $c = []; my $nc; SWITCH: { $atype eq 'fract' and do { $nc = $na > $nb ? $na: $nb; my $cn = [split //, 0 x ($nc+1)]; my $cd = [split //, 0 x ($nc+1)]; Math::Cephes::fpoladd_wrap($adata->{n}, $adata->{d}, $na, $bdata->{n}, $bdata->{d}, $nb, $cn, $cd, $nc); for (my $i=0; $i<=$nc; $i++) { my ($gcd, $n, $d) = Math::Cephes::euclid($cn->[$i], $cd->[$i]); push @$c, ($aref eq 'Math::Fraction' ? Math::Fraction->new($n, $d) : Math::Cephes::Fraction->new($n, $d) ); } last SWITCH; }; $atype eq 'cmplx' and do { $nc = $na > $nb ? $na: $nb; my $cr = [split //, 0 x ($nc+1)]; my $ci = [split //, 0 x ($nc+1)]; Math::Cephes::poladd($adata->{r}, $na, $bdata->{r}, $nb, $cr); Math::Cephes::poladd($adata->{i}, $na, $bdata->{i}, $nb, $ci); for (my $i=0; $i<=$nc; $i++) { push @$c, ($aref eq 'Math::Complex' ? Math::Complex->make($cr->[$i], $ci->[$i]) : Math::Cephes::Complex->new($cr->[$i], $ci->[$i]) ); } last SWITCH; }; $nc = $na > $nb ? $na + 1 : $nb + 1; $c = [split //, 0 x $nc]; Math::Cephes::poladd($adata, $na, $bdata, $nb, $c); } return wantarray ? (Math::Cephes::Polynomial->new($c), $nc) : Math::Cephes::Polynomial->new($c); } sub sub { my ($self, $b) = @_; my ($atype, $aref, $adata, $na) = ($self->{type}, $self->{ref}, $self->{data}, $self->{n}); my ($btype, $bref, $bdata, $nb) = ref($b) eq 'Math::Cephes::Polynomial' ? ($b->{type}, $b->{ref}, $b->{data}, $b->{n}) : get_data($b, $aref); my $c = []; my $nc; SWITCH: { $atype eq 'fract' and do { $nc = $na > $nb ? $na: $nb; my $cn = [split //, 0 x ($nc+1)]; my $cd = [split //, 0 x ($nc+1)]; Math::Cephes::fpolsub_wrap($bdata->{n}, $bdata->{d}, $nb, $adata->{n}, $adata->{d}, $na, $cn, $cd, $nc); for (my $i=0; $i<=$nc; $i++) { my ($gcd, $n, $d) = Math::Cephes::euclid($cn->[$i], $cd->[$i]); push @$c, ($aref eq 'Math::Fraction' ? Math::Fraction->new($n, $d) : Math::Cephes::Fraction->new($n, $d) ); } last SWITCH; }; $atype eq 'cmplx' and do { $nc = $na > $nb ? $na: $nb; my $cr = [split //, 0 x ($nc+1)]; my $ci = [split //, 0 x ($nc+1)]; Math::Cephes::polsub($bdata->{r}, $nb, $adata->{r}, $na, $cr); Math::Cephes::polsub($bdata->{i}, $nb, $adata->{i}, $na, $ci); for (my $i=0; $i<=$nc; $i++) { push @$c, ($aref eq 'Math::Complex' ? Math::Complex->make($cr->[$i], $ci->[$i]) : Math::Cephes::Complex->new($cr->[$i], $ci->[$i]) ); } last SWITCH; }; $nc = $na > $nb ? $na + 1 : $nb + 1; $c = [split //, 0 x $nc]; Math::Cephes::polsub($bdata, $nb, $adata, $na, $c); } return wantarray ? (Math::Cephes::Polynomial->new($c), $nc) : Math::Cephes::Polynomial->new($c); } sub mul { my ($self, $b) = @_; my ($atype, $aref, $adata, $na) = ($self->{type}, $self->{ref}, $self->{data}, $self->{n}); my ($btype, $bref, $bdata, $nb) = ref($b) eq 'Math::Cephes::Polynomial' ? ($b->{type}, $b->{ref}, $b->{data}, $b->{n}) : get_data($b, $aref); my $c = []; my $nc; SWITCH: { $atype eq 'fract' and do { $nc = $na + $nb; my $cn = [split //, 0 x ($nc+1)]; my $cd = [split //, 1 x ($nc+1)]; Math::Cephes::fpolmul_wrap($adata->{n}, $adata->{d}, $na, $bdata->{n}, $bdata->{d}, $nb, $cn, $cd, $nc); for (my $i=0; $i<=$nc; $i++) { my ($gcd, $n, $d) = Math::Cephes::euclid($cn->[$i], $cd->[$i]); push @$c, ($aref eq 'Math::Fraction' ? Math::Fraction->new($n, $d) : Math::Cephes::Fraction->new($n, $d) ); } last SWITCH; }; $atype eq 'cmplx' and do { my $dc = $na + $nb + 3; my $cr = [split //, 0 x $dc]; my $ci = [split //, 0 x $dc]; $nc = Math::Cephes::cpmul_wrap($adata->{r}, $adata->{i}, $na+1, $bdata->{r}, $bdata->{i}, $nb+1, $cr, $ci, $dc); $cr = [ @{$cr}[0..$nc] ]; $ci = [ @{$ci}[0..$nc] ]; for (my $i=0; $i<=$nc; $i++) { push @$c, ($aref eq 'Math::Complex' ? Math::Complex->make($cr->[$i], $ci->[$i]) : Math::Cephes::Complex->new($cr->[$i], $ci->[$i]) ); } last SWITCH; }; $nc = $na + $nb + 1; $c = [split //, 0 x $nc]; Math::Cephes::polmul($adata, $na, $bdata, $nb, $c); } return wantarray ? (Math::Cephes::Polynomial->new($c), $nc) : Math::Cephes::Polynomial->new($c); } sub div { my ($self, $b) = @_; my ($atype, $aref, $adata, $na) = ($self->{type}, $self->{ref}, $self->{data}, $self->{n}); my ($btype, $bref, $bdata, $nb) = ref($b) eq 'Math::Cephes::Polynomial' ? ($b->{type}, $b->{ref}, $b->{data}, $b->{n}) : get_data($b, $aref); my $c = []; my $nc; SWITCH: { $atype eq 'fract' and do { $nc = $MAXPOL; my $cn = [split //, 0 x ($nc+1)]; my $cd = [split //, 0 x ($nc+1)]; Math::Cephes::fpoldiv_wrap($adata->{n}, $adata->{d}, $na, $bdata->{n}, $bdata->{d}, $nb, $cn, $cd, $nc); for (my $i=0; $i<=$nc; $i++) { my ($gcd, $n, $d) = Math::Cephes::euclid($cn->[$i], $cd->[$i]); push @$c, ($aref eq 'Math::Fraction' ? Math::Fraction->new($n, $d) : Math::Cephes::Fraction->new($n, $d) ); } last SWITCH; }; $atype eq 'cmplx' and do { die "Cannot do complex division"; last SWITCH; }; $nc = $MAXPOL; $c = [split //, 0 x ($nc+1)]; Math::Cephes::poldiv($adata, $na, $bdata, $nb, $c); } return wantarray ? (Math::Cephes::Polynomial->new($c), $nc) : Math::Cephes::Polynomial->new($c); } sub clr { my $self = shift; my ($atype, $aref, $adata, $na) = ($self->{type}, $self->{ref}, $self->{data}, $self->{n}); set_max() unless $flag; my $n = shift || $na; $n = $na if $n > $na; SWITCH: { $atype eq 'fract' and do { for (my $i=0; $i<=$n; $i++) { $self->{data}->{n}->[$i] = 0; $self->{data}->{d}->[$i] = 1; } last SWITCH; }; $atype eq 'cmplx' and do { for (my $i=0; $i<=$n; $i++) { $self->{data}->{r}->[$i] = 0; $self->{data}->{i}->[$i] = 0; } last SWITCH; }; for (my $i=0; $i<=$n; $i++) { $self->{data}->[$i] = 0; } } } sub sbt { my ($self, $b) = @_; my ($atype, $aref, $adata, $na) = ($self->{type}, $self->{ref}, $self->{data}, $self->{n}); my ($btype, $bref, $bdata, $nb) = ref($b) eq 'Math::Cephes::Polynomial' ? ($b->{type}, $b->{ref}, $b->{data}, $b->{n}) : get_data($b, $aref); set_max() unless $flag; my $c = []; my $nc; SWITCH: { $atype eq 'fract' and do { $nc = ($na+1)*($nb+1); my $cn = [split //, 0 x ($nc+1)]; my $cd = [split //, 0 x ($nc+1)]; Math::Cephes::fpolsbt_wrap($bdata->{n}, $bdata->{d}, $nb, $adata->{n}, $adata->{d}, $na, $cn, $cd, $nc); $nc = $na * $nb; for (my $i=0; $i<=$nc; $i++) { my ($gcd, $n, $d) = Math::Cephes::euclid($cn->[$i], $cd->[$i]); push @$c, ($aref eq 'Math::Fraction' ? Math::Fraction->new($n, $d) : Math::Cephes::Fraction->new($n, $d) ); } last SWITCH; }; $atype eq 'cmplx' and do { die "Cannot do complex substitution"; last SWITCH; }; $nc = ($na+1)*($nb+1); $c = [split //, 0 x $nc]; Math::Cephes::polsbt($bdata, $nb, $adata, $na, $c); $nc = $na*$nb; $c = [@$c[0..$nc]]; } return wantarray ? (Math::Cephes::Polynomial->new($c), $nc) : Math::Cephes::Polynomial->new($c); } sub set_max { Math::Cephes::polini($MAXPOL); $flag = 1; } sub set_fmax { Math::Cephes::fpolini($FMAXPOL); $fflag = 1; } sub eval { my $self = shift; my $x = 0 || shift; my ($atype, $aref, $adata, $na) = ($self->{type}, $self->{ref}, $self->{data}, $self->{n}); my $y; SWITCH: { $atype eq 'fract' and do { my $xref = ref($x); $y = Math::Cephes::Fraction->new(0, 1); FRACT: { not $xref and do { $x = Math::Cephes::Fraction->new($x, 1); last FRACT; }; $xref eq 'Math::Cephes::Fraction' and do { last FRACT; }; $xref eq 'Math::Fraction' and do { $x = Math::Cephes::Fraction->new($x->{frac}->[0], $x->{frac}->[1]); last FRACT; }; die "Unknown data type '$xref' for x"; } Math::Cephes::fpoleva_wrap($adata->{n}, $adata->{d}, $na, $x, $y); $y = Math::Fraction->new($y->n, $y->d) if $aref eq 'Math::Fraction'; last SWITCH; }; $atype eq 'cmplx' and do { my $r = Math::Cephes::poleva($adata->{r}, $na, $x); my $i = Math::Cephes::poleva($adata->{i}, $na, $x); $y = $aref eq 'Math::Complex' ? Math::Complex->make($r, $i) : Math::Cephes::Complex->new($r, $i); last SWITCH; }; $y = Math::Cephes::poleva($adata, $na, $x); } return $y; } sub fract_to_real { my $in = shift; my $a = []; my $n = scalar @{$in->{n}} - 1; for (my $i=0; $i<=$n; $i++) { push @$a, $in->{n}->[$i] / $in->{d}->[$i]; } return $a; } sub atn { my ($self, $bin) = @_; my $type = $self->{type}; die "Cannot take the atan of a complex polynomial" if $type eq 'cmplx'; my ($a, $b); my ($atype, $aref, $adata, $na) = ($self->{type}, $self->{ref}, $self->{data}, $self->{n}); die "Cannot take the atan of a complex polynomial" if $atype eq 'cmplx'; $a = $atype eq 'fract' ? fract_to_real($adata) : $adata; my ($btype, $bref, $bdata, $nb) = ref($bin) eq 'Math::Cephes::Polynomial' ? ($bin->{type}, $bin->{ref}, $bin->{data}, $bin->{n}) : get_data($bin); die "Cannot take the atan of a complex polynomial" if $btype eq 'cmplx'; $b = $btype eq 'fract' ? fract_to_real($bdata) : $bdata; my $c = [split //, 0 x ($MAXPOL+1)]; Math::Cephes::polatn($a, $b, $c, 16); return Math::Cephes::Polynomial->new($c); } sub sqt { my $self = shift; my $type = $self->{type}; die "Cannot take the sqrt of a complex polynomial" if $type eq 'cmplx'; my $a = $type eq 'fract' ? fract_to_real($self->{data}) : $self->coef; my $b = [split //, 0 x ($MAXPOL+1)]; Math::Cephes::polsqt($a, $b, 16); return Math::Cephes::Polynomial->new($b); } sub sin { my $self = shift; my $type = $self->{type}; die "Cannot take the sin of a complex polynomial" if $type eq 'cmplx'; my $a = $type eq 'fract' ? fract_to_real($self->{data}) : $self->coef; my $b = [split //, 0 x ($MAXPOL+1)]; Math::Cephes::polsin($a, $b, 16); return Math::Cephes::Polynomial->new($b); } sub cos { my $self = shift; my $type = $self->{type}; die "Cannot take the cos of a complex polynomial" if $type eq 'cmplx'; my $a = $type eq 'fract' ? fract_to_real($self->{data}) : $self->coef; my $b = [split //, 0 x ($MAXPOL+1)]; Math::Cephes::polcos($a, $b, 16); return Math::Cephes::Polynomial->new($b); } sub rts { my $self = shift; my ($atype, $aref, $adata, $na) = ($self->{type}, $self->{ref}, $self->{data}, $self->{n}); my ($a, $b, $ret); my $cof = [split //, 0 x ($na+1)]; my $r = [split //, 0 x ($na+1)]; my $i = [split //, 0 x ($na+1)]; SWITCH: { $atype eq 'fract' and do { $adata = fract_to_real($adata); $ret = Math::Cephes::polrt_wrap($adata, $cof, $na, $r, $i); for (my $j=0; $j<$na; $j++) { push @$b, Math::Cephes::Complex->new($r->[$j], $i->[$j]); } last SWITCH; }; $atype eq 'cmplx' and do { die "Cannot do complex root finding"; last SWITCH; }; $ret = Math::Cephes::polrt_wrap($adata, $cof, $na, $r, $i); for (my $j=0; $j<$na; $j++) { push @$b, Math::Cephes::Complex->new($r->[$j], $i->[$j]); } } return wantarray ? ($ret, $b) : $b; } 1; __END__ =head1 NAME Math::Cephes::Polynomial - Perl interface to the cephes math polynomial routines =head1 SYNOPSIS use Math::Cephes::Polynomial qw(poly); # 'poly' is a shortcut for Math::Cephes::Polynomial->new require Math::Cephes::Fraction; # if coefficients are fractions require Math::Cephes::Complex; # if coefficients are complex my $a = poly([1, 2, 3]); # a(x) = 1 + 2x + 3x^2 my $b = poly([4, 5, 6, 7]; # b(x) = 4 + 5x + 6x^2 + 7x^3 my $c = $a->add($b); # c(x) = 5 + 7x + 9x^2 + 7x^3 my $cc = $c->coef; for (my $i=0; $i<4; $i++) { print "term $i: $cc->[$i]\n"; } my $x = 2; my $r = $c->eval($x); print "At x=$x, c(x) is $r\n"; my $u1 = Math::Cephes::Complex->new(2,1); my $u2 = Math::Cephes::Complex->new(1,-3); my $v1 = Math::Cephes::Complex->new(1,3); my $v2 = Math::Cephes::Complex->new(2,4); my $z1 = Math::Cephes::Polynomial->new([$u1, $u2]); my $z2 = Math::Cephes::Polynomial->new([$v1, $v2]); my $z3 = $z1->add($z2); my $z3c = $z3->coef; for (my $i=0; $i<2; $i++) { print "term $i: real=$z3c->{r}->[$i], imag=$z3c->{i}->[$i]\n"; } $r = $z3->eval($x); print "At x=$x, z3(x) has real=", $r->r, " and imag=", $r->i, "\n"; my $a1 = Math::Cephes::Fraction->new(1,2); my $a2 = Math::Cephes::Fraction->new(2,1); my $b1 = Math::Cephes::Fraction->new(1,2); my $b2 = Math::Cephes::Fraction->new(2,2); my $f1 = Math::Cephes::Polynomial->new([$a1, $a2]); my $f2 = Math::Cephes::Polynomial->new([$b1, $b2]); my $f3 = $f1->add($f2); my $f3c = $f3->coef; for (my $i=0; $i<2; $i++) { print "term $i: num=$f3c->{n}->[$i], den=$f3c->{d}->[$i]\n"; } $r = $f3->eval($x); print "At x=$x, f3(x) has num=", $r->n, " and den=", $r->d, "\n"; $r = $f3->eval($a1); print "At x=", $a1->n, "/", $a1->d, ", f3(x) has num=", $r->n, " and den=", $r->d, "\n"; =head1 DESCRIPTION This module is a layer on top of the basic routines in the cephes math library to handle polynomials. In the following, a Math::Cephes::Polynomial object is created as my $p = Math::Cephes::Polynomial->new($arr_ref); where C<$arr_ref> is a reference to an array which can consist of one of =over =item * floating point numbers, for polynomials with floating point coefficients, =item * I or I objects, for polynomials with fractional coefficients, =item * I or I objects, for polynomials with complex coefficients, =back The maximum degree of the polynomials handled is set by default to 256 - this can be changed by setting I<$Math::Cephes::Polynomial::MAXPOL>. A copy of a I object may be done as my $p_copy = $p->new(); and a string representation of the polynomial may be gotten through print $p->as_string; =head2 Methods The following methods are available. =over 4 =item I: get coefficients of the polynomial SYNOPSIS: my $c = $p->coef; DESCRIPTION: This returns an array reference containing the coefficients of the polynomial. =item I: set a polynomial identically equal to zero SYNOPSIS: $p->clr($n); DESCRIPTION: This sets the coefficients of the polynomial identically to 0, up to $p->[$n]. If $n is omitted, all elements are set to 0. =item I: add two polynomials SYNOPSIS: $c = $a->add($b); DESCRIPTION: This sets $c equal to $a + $b. =item I: subtract two polynomials SYNOPSIS: $c = $a->sub($b); DESCRIPTION: This sets $c equal to $a - $b. =item I: multiply two polynomials SYNOPSIS: $c = $a->mul($b); DESCRIPTION: This sets $c equal to $a * $b. =item I
: divide two polynomials SYNOPSIS: $c = $a->div($b); DESCRIPTION: This sets $c equal to $a / $b, expanded by a Taylor series. Accuracy is approximately equal to the degree of the polynomial, with an internal limit of about 16. =item I: change of variables SYNOPSIS: $c = $a->sbt($b); DESCRIPTION: If a(x) and b(x) are polynomials, then c(x) = a(b(x)) is a polynomial found by substituting b(x) for x in a(x). This method is not available for polynomials with complex coefficients. =item I: evaluate a polynomial SYNOPSIS: $s = $a->eval($x); DESCRIPTION: This evaluates the polynomial at the value $x. The returned value is of the same type as that used to represent the coefficients of the polynomial. =item I: square root of a polynomial SYNOPSIS: $b = $a->sqt(); DESCRIPTION: This finds the square root of a polynomial, evaluated by a Taylor expansion. Accuracy is approximately equal to the degree of the polynomial, with an internal limit of about 16. This method is not available for polynomials with complex coefficients. =item I: sine of a polynomial SYNOPSIS: $b = $a->sin(); DESCRIPTION: This finds the sine of a polynomial, evaluated by a Taylor expansion. Accuracy is approximately equal to the degree of the polynomial, with an internal limit of about 16. This method is not available for polynomials with complex coefficients. =item I: cosine of a polynomial SYNOPSIS: $b = $a->cos(); DESCRIPTION: This finds the cosine of a polynomial, evaluated by a Taylor expansion. Accuracy is approximately equal to the degree of the polynomial, with an internal limit of about 16. This method is not available for polynomials with complex coefficients. =item I: arctangent of the ratio of two polynomials SYNOPSIS: $c = $a->atn($b); DESCRIPTION: This finds the arctangent of the ratio $a / $b of two polynomial, evaluated by a Taylor expansion. Accuracy is approximately equal to the degree of the polynomial, with an internal limit of about 16. This method is not available for polynomials with complex coefficients. =item I: roots of a polynomial SYNOPSIS: my $w = Math::Cephes::Polynomial->new([-2, 0, -1, 0, 1]); my ($flag, $r) = $w->rts(); for (my $i=0; $i<4; $i++) { print "Root $i has real=", $r->[$i]->r, " and imag=", $r->[$i]->i, "\n"; } DESCRIPTION: This finds the roots of a polynomial. I<$flag>, if non-zero, indicates a failure of some kind. I<$roots> in an array reference of I objects holding the real and complex values of the roots found. This method is not available for polynomials with complex coefficients. ACCURACY: Termination depends on evaluation of the polynomial at the trial values of the roots. The values of multiple roots or of roots that are nearly equal may have poor relative accuracy after the first root in the neighborhood has been found. =back =head1 BUGS Please report any to Randy Kobes =head1 COPYRIGHT The C code for the Cephes Math Library is Copyright 1984, 1987, 1989, 2002 by Stephen L. Moshier, and is available at http://www.netlib.org/cephes/. Direct inquiries to 30 Frost Street, Cambridge, MA 02140. The perl interface is copyright 2000, 2002 by Randy Kobes. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Cephes-0.5306/lib/Math/Cephes/Complex.pm0000644000175000017500000003373314757250123020423 0ustar shlomifshlomif############# Class : cmplx ############## package Math::Cephes::Complex; use strict; use warnings; use vars qw(%OWNER %ITERATORS @ISA @EXPORT_OK %EXPORT_TAGS $VERSION); require Math::Cephes; require Exporter; *import = \&Exporter::import; @ISA = qw( Math::Cephes ); #my @cmplx = qw(clog cexp csin ccos ctan ccot casin cmplx # cacos catan cadd csub cmul cdiv cmov cneg cabs csqrt # csinh ccosh ctanh cpow casinh cacosh catanh); @EXPORT_OK = qw(cmplx); #%EXPORT_TAGS = ('cmplx' => [qw(cmplx)]); %OWNER = (); %ITERATORS = (); $VERSION = '0.5306'; *swig_r_get = *Math::Cephesc::cmplx_r_get; *swig_r_set = *Math::Cephesc::cmplx_r_set; *swig_i_get = *Math::Cephesc::cmplx_i_get; *swig_i_set = *Math::Cephesc::cmplx_i_set; sub new { my $pkg = shift; my $self = Math::Cephesc::new_cmplx(@_); bless $self, $pkg if defined($self); } sub DESTROY { return unless $_[0]->isa('HASH'); my $self = tied(%{$_[0]}); return unless defined $self; delete $ITERATORS{$self}; if (exists $OWNER{$self}) { Math::Cephesc::delete_cmplx($self); delete $OWNER{$self}; } } sub DISOWN { my $self = shift; my $ptr = tied(%$self); delete $OWNER{$ptr}; } sub ACQUIRE { my $self = shift; my $ptr = tied(%$self); $OWNER{$ptr} = 1; } sub r { my ($self, $value) = @_; return $self->{r} unless (defined $value); $self->{r} = $value; return $value; } sub i { my ($self, $value) = @_; return $self->{i} unless (defined $value); $self->{i} = $value; return $value; } sub cmplx { return Math::Cephes::Complex->new(@_); } sub as_string { my $z = shift; my $string; my $re = $z->{r}; my $im = $z->{i}; if ($im == 0) { $string = "$re"; } else { $string = sprintf "%f %s %f %s", $re, (int( $im / abs($im) ) == -1) ? '-' : '+' , ($im < 0) ? abs($im) : $im, 'i'; } return $string; } sub cadd { my ($z1, $z2) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::cadd($z1, $z2, $z); return $z; } sub csub { my ($z1, $z2) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::csub($z2, $z1, $z); return $z; } sub cmul { my ($z1, $z2) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::cmul($z1, $z2, $z); return $z; } sub cdiv { my ($z1, $z2) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::cdiv($z2, $z1, $z); return $z; } sub cpow { my ($z1, $z2) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::cpow($z1, $z2, $z); return $z; } sub clog { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::clog($z1, $z); return $z; } sub cexp { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::cexp($z1, $z); return $z; } sub csin { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::csin($z1, $z); return $z; } sub ccos { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::ccos($z1, $z); return $z; } sub ctan { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::ctan($z1, $z); return $z; } sub ccot { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::ccot($z1, $z); return $z; } sub casin { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::casin($z1, $z); return $z; } sub cacos { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::cacos($z1, $z); return $z; } sub catan { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::catan($z1, $z); return $z; } sub cmov { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::cmov($z1, $z); return $z; } sub cneg { my ($z1) = @_; Math::Cephes::cneg($z1); return $z1; } sub csqrt { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::csqrt($z1, $z); return $z; } sub cabs { my ($z1) = @_; my $abs = Math::Cephes::cabs($z1); return $abs; } sub csinh { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::csinh($z1, $z); return $z; } sub ccosh { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::ccosh($z1, $z); return $z; } sub ctanh { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::ctanh($z1, $z); return $z; } sub casinh { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::casinh($z1, $z); return $z; } sub cacosh { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::cacosh($z1, $z); return $z; } sub catanh { my ($z1) = @_; my $z = Math::Cephes::Complex->new(); Math::Cephes::catanh($z1, $z); return $z; } 1; __END__ =head1 NAME Math::Cephes::Complex - Perl interface to the cephes complex number routines =head1 SYNOPSIS use Math::Cephes::Complex qw(cmplx); my $z1 = cmplx(2,3); # $z1 = 2 + 3 i my $z2 = cmplx(3,4); # $z2 = 3 + 4 i my $z3 = $z1->radd($z2); # $z3 = $z1 + $z2 =head1 DESCRIPTION This module is a layer on top of the basic routines in the cephes math library to handle complex numbers. A complex number is created via any of the following syntaxes: my $f = Math::Cephes::Complex->new(3, 2); # $f = 3 + 2 i my $g = new Math::Cephes::Complex(5, 3); # $g = 5 + 3 i my $h = cmplx(7, 5); # $h = 7 + 5 i the last one being available by importing I. If no arguments are specified, as in my $h = cmplx(); then the defaults $z = 0 + 0 i are assumed. The real and imaginary part of a complex number are represented respectively by $f->{r}; $f->{i}; or, as methods, $f->r; $f->i; and can be set according to $f->{r} = 4; $f->{i} = 9; or, again, as methods, $f->r(4); $f->i(9); The complex number can be printed out as print $f->as_string; A summary of the usage is as follows. =over 4 =item I: Complex circular sine SYNOPSIS: # void csin(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->csin; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: If z = x + iy, then w = sin x cosh y + i cos x sinh y. =item I: Complex circular cosine SYNOPSIS: # void ccos(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->ccos; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: If z = x + iy, then w = cos x cosh y - i sin x sinh y. =item I: Complex circular tangent SYNOPSIS: # void ctan(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->ctan; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: If z = x + iy, then sin 2x + i sinh 2y w = --------------------. cos 2x + cosh 2y On the real axis the denominator is zero at odd multiples of PI/2. The denominator is evaluated by its Taylor series near these points. =item I: Complex circular cotangent SYNOPSIS: # void ccot(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->ccot; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: If z = x + iy, then sin 2x - i sinh 2y w = --------------------. cosh 2y - cos 2x On the real axis, the denominator has zeros at even multiples of PI/2. Near these points it is evaluated by a Taylor series. =item I: Complex circular arc sine SYNOPSIS: # void casin(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->casin; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: Inverse complex sine: 2 w = -i clog( iz + csqrt( 1 - z ) ). =item I: Complex circular arc cosine SYNOPSIS: # void cacos(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->cacos; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: w = arccos z = PI/2 - arcsin z. =item I: Complex circular arc tangent SYNOPSIS: # void catan(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->catan; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: If z = x + iy, then 1 ( 2x ) Re w = - arctan(-----------) + k PI 2 ( 2 2) (1 - x - y ) ( 2 2) 1 (x + (y+1) ) Im w = - log(------------) 4 ( 2 2) (x + (y-1) ) Where k is an arbitrary integer. =item I: Complex hyperbolic sine SYNOPSIS: # void csinh(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->csinh; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: csinh z = (cexp(z) - cexp(-z))/2 = sinh x * cos y + i cosh x * sin y . =item I: Complex inverse hyperbolic sine SYNOPSIS: # void casinh(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->casinh; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: casinh z = -i casin iz . =item I: Complex hyperbolic cosine SYNOPSIS: # void ccosh(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->ccosh; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: ccosh(z) = cosh x cos y + i sinh x sin y . =item I: Complex inverse hyperbolic cosine SYNOPSIS: # void cacosh(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->cacosh; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: acosh z = i acos z . =item I: Complex hyperbolic tangent SYNOPSIS: # void ctanh(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->ctanh; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: tanh z = (sinh 2x + i sin 2y) / (cosh 2x + cos 2y) . =item I: Complex inverse hyperbolic tangent SYNOPSIS: # void catanh(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->catanh; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: Inverse tanh, equal to -i catan (iz); =item I: Complex power function SYNOPSIS: # void cpow(); # cmplx a, z, w; $a = cmplx(5, 6); # $z = 5 + 6 i $z = cmplx(2, 3); # $z = 2 + 3 i $w = $a->cpow($z); print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: Raises complex A to the complex Zth power. Definition is per AMS55 # 4.2.8, analytically equivalent to cpow(a,z) = cexp(z clog(a)). =item I: Complex number arithmetic SYNOPSIS: # typedef struct { # double r; real part # double i; imaginary part # }cmplx; # cmplx *a, *b, *c; $a = cmplx(3, 5); # $a = 3 + 5 i $b = cmplx(2, 3); # $b = 2 + 3 i $c = $a->cadd( $b ); # c = a + b $c = $a->csub( $b ); # c = a - b $c = $a->cmul( $b ); # c = a * b $c = $a->cdiv( $b ); # c = a / b $c = $a->cneg; # c = -a $c = $a->cmov; # c = a print $c->{r}, ' ', $c->{i}; # prints real and imaginary parts of $c print $c->as_string; # prints $c as Re($c) + i Im($c) DESCRIPTION: Addition: c.r = b.r + a.r c.i = b.i + a.i Subtraction: c.r = b.r - a.r c.i = b.i - a.i Multiplication: c.r = b.r * a.r - b.i * a.i c.i = b.r * a.i + b.i * a.r Division: d = a.r * a.r + a.i * a.i c.r = (b.r * a.r + b.i * a.i)/d c.i = (b.i * a.r - b.r * a.i)/d =item I: Complex absolute value SYNOPSIS: # double a, cabs(); # cmplx z; $z = cmplx(2, 3); # $z = 2 + 3 i $a = cabs( $z ); DESCRIPTION: If z = x + iy then a = sqrt( x**2 + y**2 ). Overflow and underflow are avoided by testing the magnitudes of x and y before squaring. If either is outside half of the floating point full scale range, both are rescaled. =item I: Complex square root SYNOPSIS: # void csqrt(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->csqrt; print $w->{r}, ' ', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re($w) + i Im($w) DESCRIPTION: If z = x + iy, r = |z|, then 1/2 Im w = [ (r - x)/2 ] , Re w = y / 2 Im w. Note that -w is also a square root of z. The root chosen is always in the upper half plane. Because of the potential for cancellation error in r - x, the result is sharpened by doing a Heron iteration (see sqrt.c) in complex arithmetic. =back =head1 BUGS Please report any to Randy Kobes =head1 SEE ALSO For the basic interface to the cephes complex number routines, see L. See also L for a more extensive interface to complex number routines. =head1 COPYRIGHT The C code for the Cephes Math Library is Copyright 1984, 1987, 1989, 2002 by Stephen L. Moshier, and is available at http://www.netlib.org/cephes/. Direct inquiries to 30 Frost Street, Cambridge, MA 02140. The perl interface is copyright 2000, 2002 by Randy Kobes. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Math-Cephes-0.5306/MANIFEST0000644000175000017500000000463214757250372014743 0ustar shlomifshlomif.gitignore arrays.c arrays.h Cephes.bs Cephes.i Cephes_wrap.c Changes INSTALL lib/Math/Cephes.pm lib/Math/Cephes.pod lib/Math/Cephes/Complex.pm lib/Math/Cephes/Fraction.pm lib/Math/Cephes/Matrix.pm lib/Math/Cephes/Polynomial.pm libmd/acosh.c libmd/airy.c libmd/arcdot.c libmd/asin.c libmd/asinh.c libmd/atan.c libmd/atanh.c libmd/bdtr.c libmd/bernum_wrap.c libmd/beta.c libmd/btdtr.c libmd/cbrt.c libmd/chbevl.c libmd/chdtr.c libmd/clog.c libmd/cmplx.c libmd/const.c libmd/cosh.c libmd/cpmul.c libmd/cpmul_wrap.c libmd/dawsn.c libmd/drand.c libmd/ei.c libmd/eigens.c libmd/ellie.c libmd/ellik.c libmd/ellpe.c libmd/ellpj.c libmd/ellpk.c libmd/euclid.c libmd/exp.c libmd/exp10.c libmd/exp2.c libmd/expn.c libmd/expx2.c libmd/fabs.c libmd/fac.c libmd/fdtr.c libmd/floor.387 libmd/floor.c libmd/floorelf.387 libmd/fresnl.c libmd/gamma.c libmd/gdtr.c libmd/hyp2f1.c libmd/hyperg.c libmd/i0.c libmd/i1.c libmd/igam.c libmd/igami.c libmd/incbet.c libmd/incbi.c libmd/isnan.c libmd/iv.c libmd/j0.c libmd/j1.c libmd/jn.c libmd/jv.c libmd/k0.c libmd/k1.c libmd/kn.c libmd/libmd.a libmd/log.c libmd/log10.c libmd/log2.c libmd/lrand.c libmd/lsqrt.c libmd/Makefile.PL libmd/mconf.h libmd/minv.c libmd/mtherr.c libmd/mtransp.c libmd/nbdtr.c libmd/ndtr.c libmd/ndtri.c libmd/pdtr.c libmd/planck.c libmd/polevl.c libmd/polmisc.c libmd/polrt.c libmd/polrt_wrap.c libmd/polylog.c libmd/polyn.c libmd/polyr.c libmd/polyr_wrap.c libmd/pow.c libmd/powi.c libmd/protos.h libmd/psi.c libmd/rgamma.c libmd/round.c libmd/setpmsvc.c.win32 libmd/setprec.387 libmd/setprec.688 libmd/setprec.87 libmd/setprec.c libmd/setprec.c.unix libmd/setprelf.387 libmd/shichi.c libmd/sici.c libmd/simpsn.c libmd/simpsn_wrap.c libmd/simq.c libmd/sin.c libmd/sindg.c libmd/sinh.c libmd/spence.c libmd/sqrt.387 libmd/sqrt.688 libmd/sqrt.87 libmd/sqrt.c libmd/sqrt.c.src libmd/sqrt.spa libmd/sqrtelf.387 libmd/stdtr.c libmd/struve.c libmd/tan.c libmd/tandg.c libmd/tanh.c libmd/unity.c libmd/yn.c libmd/zeta.c libmd/zetac.c LICENSE Makefile.PL MANIFEST META.yml Module meta-data (added by MakeMaker) pm_to_blib pmath README scripts/bump-version-number.pl t/99pod.t t/bessels.t t/betas.t t/cmplx.t t/cpan-changes.t t/dists.t t/elliptics.t t/explog.t t/fract.t t/gammas.t t/hypergeometrics.t t/hypers.t t/lib/Utils.pm t/mat.t t/misc.t t/new_cmplx-2.t t/new_cmplx.t t/poly.t t/style-trailing-space.t t/trig.t t/utils.t META.json Module JSON meta-data (added by MakeMaker) Math-Cephes-0.5306/Changes0000644000175000017500000001142114757250031015067 0ustar shlomifshlomifRevision history for Math::Cephes 0.5306 2025-02-25 - Convert Changes to CPAN::Changes format. - Some patches from debian.org for better portability. - Thanks! - Modernization / refactoring. 0.5305 2016-05-06 - Remove trailing whitespace - with a test. - Add LICENSE file (CPANTS). - Add "use warnings" (CPANTS). - Set minimal Perl version (CPANTS). - Hopefully fix failing tests on FreeBSD/etc. with the new ExtUtils::MakeMaker . - https://rt.cpan.org/Ticket/Display.html?id=114158 - Thanks to Slaven Rezic for the report and to BINGOS for a proposed fix. 0.5304 2014-01-31 - Add scripts/bump-version-number.pl to bump the version number. - Add license to META.yml and a LICENSE file (CPANTS). - Add "use warnings;" to all modules (CPANTS). 0.5303 2013-10-11 - Add Repository CPAN Metadata. - thanks to David Steinbrunner 0.5302 2012-11-11 - Fix https://rt.cpan.org/Ticket/Display.html?id=81105 . - Fails on perls with nvsize != 8. - Due to using Test::More::is() for floating-point comparisons. - Thanks to ANDK for the report. 0.5301 2012-11-11 - Fix the second test case (without explicit use Math::Cephes::Complex) in https://rt.cpan.org/Ticket/Display.html?id=80624 . 0.53 2012-11-10 - Fix the exporting of new_cmplx: - https://rt.cpan.org/Ticket/Display.html?id=80624 0.52 2012-11-02 - Change the author to a different account. - Done to try and avoid getting over report that the module "has no active maintainer"). 0.51 2012-10-23 - Fix the auto-generation of META.yml/META.json. - There was a NO_META in the Makefile.PL (WTF?), which preserved the existing META. 0.50 2012-10-23 - New version to get over a CPAN/PAUSE's SNAFU. - The CPAN clients don't install the right version. - Thanks to aero for the report, and John M. Gamble and Steffen Mueller for some insights. 0.48 2012-07-14 - Apply patch to Makefile.PL to fix builds on x86-64 Macintosh: - https://rt.cpan.org/Ticket/Display.html?id=75730 - Thanks to Ian Barton for the report and the patch. - Update lib/Math/Cephes.pod with up-to-date information. 0.47 2009-01-06 - dmake requires creation of dummy libmd file (reported by Sisyphus) 0.46 2009-01-02 - Intel Mac support (dsteinbrunner): http://rt.cpan.org/Public/Bug/Display.html?id=25842 - support for building on cygwin (patch supplied by Sisyphus) - remove LIBS from Makefile.PL, so as not to require creation of dummy libmd library, which causes problems on some platforms: https://rt.cpan.org/Ticket/Display.html?id=19716 - don't run test 36 of t/poly.t, which seems to fail consistently on some platforms: http://cpantesters.perl.org/show/Math-Cephes.html 0.45 2007-07-26 - fix bug in Math::Cephes::Complex to allow 0 as a value (thanks to Dan Connelly) 0.44 2007-04-07 - allow Darwin to use default config for Mac OSX 10 (Chip Stewart) 0.43 2006-06-17 - add lgam to list of functions in "gammas" tag (spotted by Philip Lijnzaad) - allow clr() method of Math::Cephes::Matrix to accept a value to set all matrix elements equal to - incorporate a couple of small changes in igam.c, igami.c, polylog.c, and hyperg.c to bring them in synch to cephes 0.28. 0.42 2004-03-21 - fix bug in Math::Cephes::Polynomial in the mult routine to get the right size of the resulting polynomial 0.41 2003-12-30 - use dummy setprec.c for Darwin - remove unneeded Math::cephes::fract - create bogus libmd/libmd lib, to avoid MakeMaker warning 0.40 2003-12-20 - move Cephes_wrap.c and arrays.c to top-level directory and configure Makefile.PL to build static libmd. - generate a mconf.h for darwin (thanks to Thomas Puzia) - upgraded Cephes_wrap.c swig wrapper - prepended md_ prefix to many functions, to avoid collisions with system functions (thanks to Thomas Puzia and David Martin for pointing out the problem) 0.36 2002-09-12 - added functions that require arrays into and out from C (simpson's rule, polynomial and matrix routines). - added Math::Cephes::Polynomial and Math::Cephes::Matrix - added Solaris mconf.h that mostly works (thanks to Jost Krieger). 0.25 2000-10-25 - changed Cephes_wrap.c to compile when MULTIPLICITY in perl 5.6.0 is defined (addition of pTHX_) 0.20 2000-03-12 - changed name from Math::Functions to Math::Cephes - added Math::Cephes::Fraction and Math::Cephes::Complex for a more "perlish" interface - added '-g -Wall -fno-builtin' when compiling with gcc - small documentation improvements - some changes to the pmath script, including the interface to handle fractions and complex numbers 0.10 2000-02-14 - original version, created by Swig with help from h2xs Math-Cephes-0.5306/arrays.h0000644000175000017500000000206614757021403015252 0ustar shlomifshlomif/* These are the function prototypes for arrays.c */ /* Functions defined in this module, see header comments on each one for more details: */ #ifndef _INC_ARRAYS_ void* pack1D(SV* arg, char packtype); /* Pack perl 1D array */ void* pack2D(SV* arg, char packtype); /* Pack perl 1-2D array */ void* packND(SV* arg, char packtype); /* Pack perl array N-D array */ void unpack1D(SV* arg, void * var, /* Unpack 1D array */ char packtype, int n); AV* coerce1D ( SV* arg, int n ); /* Coerce/create array to specified size */ void* get_mortalspace( int n, char packtype ); /* Utility to just get workspace */ /* Sort out macro name changes in 5.004_53 (PATCHLEVEL < 5) Note that recent Perl versions don't define PATCHLEVEL by default */ #ifndef PATCHLEVEL #include #endif #if defined(PATCHLEVEL) && (PATCHLEVEL < 5) #define PL_na na #endif /* Prevent the prototypes being defined twice */ #define _INC_ARRAYS_ #endif Math-Cephes-0.5306/Cephes_wrap.c0000644000175000017500000053422714757021403016215 0ustar shlomifshlomif/* ---------------------------------------------------------------------------- * This file was automatically generated by SWIG (http://www.swig.org). * Version 1.3.20 * * This file is not intended to be easily readable and contains a number of * coding conventions designed to improve portability and efficiency. Do not make * changes to this file unless you know what you are doing--modify the SWIG * interface file instead. * ----------------------------------------------------------------------------- */ /*************************************************************** -*- c -*- * perl5/precommon.swg * * Rename all exported symbols from common.swg, to avoid symbol * clashes if multiple interpreters are included * ************************************************************************/ #define SWIG_TypeRegister SWIG_Perl_TypeRegister #define SWIG_TypeCheck SWIG_Perl_TypeCheck #define SWIG_TypeCast SWIG_Perl_TypeCast #define SWIG_TypeDynamicCast SWIG_Perl_TypeDynamicCast #define SWIG_TypeName SWIG_Perl_TypeName #define SWIG_TypeQuery SWIG_Perl_TypeQuery #define SWIG_TypeClientData SWIG_Perl_TypeClientData #define SWIG_PackData SWIG_Perl_PackData #define SWIG_UnpackData SWIG_Perl_UnpackData /*********************************************************************** * common.swg * * This file contains generic SWIG runtime support for pointer * type checking as well as a few commonly used macros to control * external linkage. * * Author : David Beazley (beazley@cs.uchicago.edu) * * Copyright (c) 1999-2000, The University of Chicago * * This file may be freely redistributed without license or fee provided * this copyright message remains intact. ************************************************************************/ #include #if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__) # if defined(_MSC_VER) || defined(__GNUC__) # if defined(STATIC_LINKED) # define SWIGEXPORT(a) a # define SWIGIMPORT(a) extern a # else # define SWIGEXPORT(a) __declspec(dllexport) a # define SWIGIMPORT(a) extern a # endif # else # if defined(__BORLANDC__) # define SWIGEXPORT(a) a _export # define SWIGIMPORT(a) a _export # else # define SWIGEXPORT(a) a # define SWIGIMPORT(a) a # endif # endif #else # define SWIGEXPORT(a) a # define SWIGIMPORT(a) a #endif #ifdef SWIG_GLOBAL # define SWIGRUNTIME(a) SWIGEXPORT(a) #else # define SWIGRUNTIME(a) static a #endif #ifdef __cplusplus extern "C" { #endif typedef void *(*swig_converter_func)(void *); typedef struct swig_type_info *(*swig_dycast_func)(void **); typedef struct swig_type_info { const char *name; swig_converter_func converter; const char *str; void *clientdata; swig_dycast_func dcast; struct swig_type_info *next; struct swig_type_info *prev; } swig_type_info; #ifdef SWIG_NOINCLUDE SWIGIMPORT(swig_type_info *) SWIG_TypeRegister(swig_type_info *); SWIGIMPORT(swig_type_info *) SWIG_TypeCheck(char *c, swig_type_info *); SWIGIMPORT(void *) SWIG_TypeCast(swig_type_info *, void *); SWIGIMPORT(swig_type_info *) SWIG_TypeDynamicCast(swig_type_info *, void **); SWIGIMPORT(const char *) SWIG_TypeName(const swig_type_info *); SWIGIMPORT(swig_type_info *) SWIG_TypeQuery(const char *); SWIGIMPORT(void) SWIG_TypeClientData(swig_type_info *, void *); SWIGIMPORT(char *) SWIG_PackData(char *, void *, int); SWIGIMPORT(char *) SWIG_UnpackData(char *, void *, int); #else static swig_type_info *swig_type_list = 0; /* Register a type mapping with the type-checking */ SWIGRUNTIME(swig_type_info *) SWIG_TypeRegister(swig_type_info *ti) { swig_type_info *tc, *head, *ret, *next; /* Check to see if this type has already been registered */ tc = swig_type_list; while (tc) { if (strcmp(tc->name, ti->name) == 0) { /* Already exists in the table. Just add additional types to the list */ if (tc->clientdata) ti->clientdata = tc->clientdata; head = tc; next = tc->next; goto l1; } tc = tc->prev; } head = ti; next = 0; /* Place in list */ ti->prev = swig_type_list; swig_type_list = ti; /* Build linked lists */ l1: ret = head; tc = ti + 1; /* Patch up the rest of the links */ while (tc->name) { head->next = tc; tc->prev = head; head = tc; tc++; } if (next) next->prev = head; head->next = next; return ret; } /* Check the typename */ SWIGRUNTIME(swig_type_info *) SWIG_TypeCheck(char *c, swig_type_info *ty) { swig_type_info *s; if (!ty) return 0; /* Void pointer */ s = ty->next; /* First element always just a name */ do { if (strcmp(s->name,c) == 0) { if (s == ty->next) return s; /* Move s to the top of the linked list */ s->prev->next = s->next; if (s->next) { s->next->prev = s->prev; } /* Insert s as second element in the list */ s->next = ty->next; if (ty->next) ty->next->prev = s; ty->next = s; s->prev = ty; return s; } s = s->next; } while (s && (s != ty->next)); return 0; } /* Cast a pointer up an inheritance hierarchy */ SWIGRUNTIME(void *) SWIG_TypeCast(swig_type_info *ty, void *ptr) { if ((!ty) || (!ty->converter)) return ptr; return (*ty->converter)(ptr); } /* Dynamic pointer casting. Down an inheritance hierarchy */ SWIGRUNTIME(swig_type_info *) SWIG_TypeDynamicCast(swig_type_info *ty, void **ptr) { swig_type_info *lastty = ty; if (!ty || !ty->dcast) return ty; while (ty && (ty->dcast)) { ty = (*ty->dcast)(ptr); if (ty) lastty = ty; } return lastty; } /* Return the name associated with this type */ SWIGRUNTIME(const char *) SWIG_TypeName(const swig_type_info *ty) { return ty->name; } /* Search for a swig_type_info structure */ SWIGRUNTIME(swig_type_info *) SWIG_TypeQuery(const char *name) { swig_type_info *ty = swig_type_list; while (ty) { if (ty->str && (strcmp(name,ty->str) == 0)) return ty; if (ty->name && (strcmp(name,ty->name) == 0)) return ty; ty = ty->prev; } return 0; } /* Set the clientdata field for a type */ SWIGRUNTIME(void) SWIG_TypeClientData(swig_type_info *ti, void *clientdata) { swig_type_info *tc, *equiv; if (ti->clientdata == clientdata) return; ti->clientdata = clientdata; equiv = ti->next; while (equiv) { if (!equiv->converter) { tc = swig_type_list; while (tc) { if ((strcmp(tc->name, equiv->name) == 0)) SWIG_TypeClientData(tc,clientdata); tc = tc->prev; } } equiv = equiv->next; } } /* Pack binary data into a string */ SWIGRUNTIME(char *) SWIG_PackData(char *c, void *ptr, int sz) { static char hex[17] = "0123456789abcdef"; int i; unsigned char *u = (unsigned char *) ptr; register unsigned char uu; for (i = 0; i < sz; i++,u++) { uu = *u; *(c++) = hex[(uu & 0xf0) >> 4]; *(c++) = hex[uu & 0xf]; } return c; } /* Unpack binary data from a string */ SWIGRUNTIME(char *) SWIG_UnpackData(char *c, void *ptr, int sz) { register unsigned char uu = 0; register int d; unsigned char *u = (unsigned char *) ptr; int i; for (i = 0; i < sz; i++, u++) { d = *(c++); if ((d >= '0') && (d <= '9')) uu = ((d - '0') << 4); else if ((d >= 'a') && (d <= 'f')) uu = ((d - ('a'-10)) << 4); d = *(c++); if ((d >= '0') && (d <= '9')) uu |= (d - '0'); else if ((d >= 'a') && (d <= 'f')) uu |= (d - ('a'-10)); *u = uu; } return c; } #endif #ifdef __cplusplus } #endif /* ---------------------------------------------------------------------- -*- c -*- * perl5.swg * * Perl5 runtime library * $Header: /home/cvs/Math-Cephes/Cephes_wrap.c,v 1.1 2003/12/22 16:48:39 randy Exp $ * ----------------------------------------------------------------------------- */ #define SWIGPERL #define SWIGPERL5 #ifdef __cplusplus /* Needed on some windows machines---since MS plays funny games with the header files under C++ */ #include #include extern "C" { #endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "arrays.h" /* Get rid of free and malloc defined by perl */ #undef free #undef malloc #ifndef pTHX_ #define pTHX_ #endif #include #ifdef __cplusplus } #endif /* Macro to call an XS function */ #ifdef PERL_OBJECT # define SWIG_CALLXS(_name) _name(cv,pPerl) #else # ifndef MULTIPLICITY # define SWIG_CALLXS(_name) _name(cv) # else # define SWIG_CALLXS(_name) _name(PERL_GET_THX, cv) # endif #endif /* Contract support */ #define SWIG_contract_assert(expr,msg) if (!(expr)) { SWIG_croak(msg); } else /* Note: SwigMagicFuncHack is a typedef used to get the C++ compiler to just shut up already */ #ifdef PERL_OBJECT #define MAGIC_PPERL CPerlObj *pPerl = (CPerlObj *) this; typedef int (CPerlObj::*SwigMagicFunc)(SV *, MAGIC *); #ifdef __cplusplus extern "C" { #endif typedef int (CPerlObj::*SwigMagicFuncHack)(SV *, MAGIC *); #ifdef __cplusplus } #endif #define SWIG_MAGIC(a,b) (SV *a, MAGIC *b) #define SWIGCLASS_STATIC #else #define MAGIC_PPERL #define SWIGCLASS_STATIC static #ifndef MULTIPLICITY #define SWIG_MAGIC(a,b) (SV *a, MAGIC *b) typedef int (*SwigMagicFunc)(SV *, MAGIC *); #ifdef __cplusplus extern "C" { #endif typedef int (*SwigMagicFuncHack)(SV *, MAGIC *); #ifdef __cplusplus } #endif #else #define SWIG_MAGIC(a,b) (struct interpreter *interp, SV *a, MAGIC *b) typedef int (*SwigMagicFunc)(struct interpreter *, SV *, MAGIC *); #ifdef __cplusplus extern "C" { #endif typedef int (*SwigMagicFuncHack)(struct interpreter *, SV *, MAGIC *); #ifdef __cplusplus } #endif #endif #endif #if defined(WIN32) && defined(PERL_OBJECT) && !defined(PerlIO_exportFILE) #define PerlIO_exportFILE(fh,fl) (FILE*)(fh) #endif /* Modifications for newer Perl 5.005 releases */ #if !defined(PERL_REVISION) || ((PERL_REVISION >= 5) && ((PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION < 50)))) # ifndef PL_sv_yes # define PL_sv_yes sv_yes # endif # ifndef PL_sv_undef # define PL_sv_undef sv_undef # endif # ifndef PL_na # define PL_na na # endif #endif #include #ifdef __cplusplus extern "C" { #endif #define SWIG_OWNER 1 #define SWIG_SHADOW 2 /* Common SWIG API */ #ifdef PERL_OBJECT # define SWIG_ConvertPtr(obj, pp, type, flags) \ SWIG_Perl_ConvertPtr(pPerl, obj, pp, type, flags) # define SWIG_NewPointerObj(p, type, flags) \ SWIG_Perl_NewPointerObj(pPerl, p, type, flags) # define SWIG_MakePackedObj(sv, p, s, type) \ SWIG_Perl_MakePackedObj(pPerl, sv, p, s, type) # define SWIG_ConvertPacked(obj, p, s, type, flags) \ SWIG_Perl_ConvertPacked(pPerl, obj, p, s, type, flags) #else # define SWIG_ConvertPtr(obj, pp, type, flags) \ SWIG_Perl_ConvertPtr(obj, pp, type, flags) # define SWIG_NewPointerObj(p, type, flags) \ SWIG_Perl_NewPointerObj(p, type, flags) # define SWIG_MakePackedObj(sv, p, s, type) \ SWIG_Perl_MakePackedObj(sv, p, s, type ) # define SWIG_ConvertPacked(obj, p, s, type, flags) \ SWIG_Perl_ConvertPacked(obj, p, s, type, flags) #endif /* Perl-specific API */ #ifdef PERL_OBJECT # define SWIG_MakePtr(sv, ptr, type, flags) \ SWIG_Perl_MakePtr(pPerl, sv, ptr, type, flags) # define SWIG_TypeCheckRV(rv, ty) \ SWIG_Perl_TypeCheckRV(pPerl, rv, ty) # define SWIG_SetError(str) \ SWIG_Perl_SetError(pPerl, str) #else # define SWIG_MakePtr(sv, ptr, type, flags) \ SWIG_Perl_MakePtr(sv, ptr, type, flags) # define SWIG_TypeCheckRV(rv, ty) \ SWIG_Perl_TypeCheckRV(rv, ty) # define SWIG_SetError(str) \ SWIG_Perl_SetError(str) # define SWIG_SetErrorSV(str) \ SWIG_Perl_SetErrorSV(str) #endif #define SWIG_SetErrorf SWIG_Perl_SetErrorf #ifdef PERL_OBJECT # define SWIG_MAYBE_PERL_OBJECT CPerlObj *pPerl, #else # define SWIG_MAYBE_PERL_OBJECT #endif #ifdef SWIG_NOINCLUDE SWIGIMPORT(int) SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *, void **, swig_type_info *, int flags); SWIGIMPORT(void) SWIG_Perl_MakePtr(SWIG_MAYBE_PERL_OBJECT SV *, void *, swig_type_info *, int flags); SWIGIMPORT(SV *) SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT void *, swig_type_info *, int flags); SWIGIMPORT(void) SWIG_Perl_MakePackedObj(SWIG_MAYBE_PERL_OBJECT SV *, void *, int, swig_type_info *); SWIGIMPORT(int) SWIG_Perl_ConvertPacked(SWIG_MAYBE_PERL_OBJECT SV *, void *, int, swig_type_info *, int flags); SWIGIMPORT(swig_type_info *) SWIG_Perl_TypeCheckRV(SWIG_MAYBE_PERL_OBJECT SV *rv, swig_type_info *ty); SWIGIMPORT(SV *) SWIG_Perl_SetError(SWIG_MAYBE_PERL_OBJECT char *); #else SWIGRUNTIME(swig_type_info *) SWIG_Perl_TypeCheckRV(SWIG_MAYBE_PERL_OBJECT SV *rv, swig_type_info *ty) { swig_type_info *s; if (!ty) return 0; /* Void pointer */ s = ty->next; /* First element always just a name */ do { if (sv_derived_from(rv, (char *) s->name)) { if (s == ty->next) return s; /* Move s to the top of the linked list */ s->prev->next = s->next; if (s->next) { s->next->prev = s->prev; } /* Insert s as second element in the list */ s->next = ty->next; if (ty->next) ty->next->prev = s; ty->next = s; s->prev = ty; return s; } s = s->next; } while (s && (s != ty->next)); return 0; } /* Function for getting a pointer value */ SWIGRUNTIME(int) SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags) { swig_type_info *tc; void *voidptr = (void *)0; /* If magical, apply more magic */ if (SvGMAGICAL(sv)) mg_get(sv); /* Check to see if this is an object */ if (sv_isobject(sv)) { SV *tsv = (SV*) SvRV(sv); IV tmp = 0; if ((SvTYPE(tsv) == SVt_PVHV)) { MAGIC *mg; if (SvMAGICAL(tsv)) { mg = mg_find(tsv,'P'); if (mg) { SV *rsv = mg->mg_obj; if (sv_isobject(rsv)) { tmp = SvIV((SV*)SvRV(rsv)); } } } else { return -1; } } else { tmp = SvIV((SV*)SvRV(sv)); } voidptr = (void *)tmp; if (!_t) { *(ptr) = voidptr; return 0; } } else if (! SvOK(sv)) { /* Check for undef */ *(ptr) = (void *) 0; return 0; } else if (SvTYPE(sv) == SVt_RV) { /* Check for NULL pointer */ *(ptr) = (void *) 0; if (!SvROK(sv)) return 0; else return -1; } else { /* Don't know what it is */ *(ptr) = (void *) 0; return -1; } if (_t) { /* Now see if the types match */ tc = SWIG_TypeCheckRV(sv,_t); if (!tc) { *ptr = voidptr; return -1; } *ptr = SWIG_TypeCast(tc,voidptr); return 0; } *ptr = voidptr; return 0; } SWIGRUNTIME(void) SWIG_Perl_MakePtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, swig_type_info *t, int flags) { if (ptr && (flags & SWIG_SHADOW)) { SV *self; SV *obj=newSV(0); HV *hash=newHV(); HV *stash; sv_setref_pv(obj, (char *) t->name, ptr); stash=SvSTASH(SvRV(obj)); if (flags & SWIG_OWNER) { HV *hv; GV *gv=*(GV**)hv_fetch(stash, "OWNER", 5, TRUE); if (!isGV(gv)) gv_init(gv, stash, "OWNER", 5, FALSE); hv=GvHVn(gv); hv_store_ent(hv, obj, newSViv(1), 0); } sv_magic((SV *)hash, (SV *)obj, 'P', Nullch, 0); SvREFCNT_dec(obj); self=newRV_noinc((SV *)hash); sv_setsv(sv, self); SvREFCNT_dec((SV *)self); sv_bless(sv, stash); } else { sv_setref_pv(sv, (char *) t->name, ptr); } } SWIGRUNTIME(SV *) SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT void *ptr, swig_type_info *t, int flags) { SV *result = sv_newmortal(); SWIG_MakePtr(result, ptr, t, flags); return result; } SWIGRUNTIME(void) SWIG_Perl_MakePackedObj(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, int sz, swig_type_info *type) { char result[1024]; char *r = result; if ((2*sz + 1 + strlen(type->name)) > 1000) return; *(r++) = '_'; r = SWIG_PackData(r,ptr,sz); strcpy(r,type->name); sv_setpv(sv, result); } /* Convert a packed value value */ SWIGRUNTIME(int) SWIG_Perl_ConvertPacked(SWIG_MAYBE_PERL_OBJECT SV *obj, void *ptr, int sz, swig_type_info *ty, int flags) { swig_type_info *tc; char *c = 0; if ((!obj) || (!SvOK(obj))) return -1; c = SvPV(obj, PL_na); /* Pointer values must start with leading underscore */ if (*c != '_') return -1; c++; c = SWIG_UnpackData(c,ptr,sz); if (ty) { tc = SWIG_TypeCheck(c,ty); if (!tc) return -1; } return 0; } SWIGRUNTIME(void) SWIG_Perl_SetError(SWIG_MAYBE_PERL_OBJECT const char *error) { if (error) sv_setpv(perl_get_sv("@", TRUE), error); } SWIGRUNTIME(void) SWIG_Perl_SetErrorSV(SWIG_MAYBE_PERL_OBJECT SV *error) { if (error) sv_setsv(perl_get_sv("@", TRUE), error); } SWIGRUNTIME(void) SWIG_Perl_SetErrorf(const char *fmt, ...) { va_list args; va_start(args, fmt); sv_vsetpvfn(perl_get_sv("@", TRUE), fmt, strlen(fmt), &args, Null(SV**), 0, Null(bool*)); va_end(args); } #endif /* Macros for low-level exception handling */ #define SWIG_fail goto fail #define SWIG_croak(x) { SWIG_SetError(x); goto fail; } #define SWIG_croakSV(x) { SWIG_SetErrorSV(x); goto fail; } /* most preprocessors do not support vararg macros :-( */ /* #define SWIG_croakf(x...) { SWIG_SetErrorf(x); goto fail; } */ typedef XS(SwigPerlWrapper); typedef SwigPerlWrapper *SwigPerlWrapperPtr; /* Structure for command table */ typedef struct { const char *name; SwigPerlWrapperPtr wrapper; } swig_command_info; /* Information for constant table */ #define SWIG_INT 1 #define SWIG_FLOAT 2 #define SWIG_STRING 3 #define SWIG_POINTER 4 #define SWIG_BINARY 5 /* Constant information structure */ typedef struct swig_constant_info { int type; const char *name; long lvalue; double dvalue; void *pvalue; swig_type_info **ptype; } swig_constant_info; #ifdef __cplusplus } #endif /* Structure for variable table */ typedef struct { const char *name; SwigMagicFunc set; SwigMagicFunc get; swig_type_info **type; } swig_variable_info; /* Magic variable code */ #ifndef PERL_OBJECT #define swig_create_magic(s,a,b,c) _swig_create_magic(s,a,b,c) #ifndef MULTIPLICITY static void _swig_create_magic(SV *sv, char *name, int (*set)(SV *, MAGIC *), int (*get)(SV *,MAGIC *)) { #else static void _swig_create_magic(SV *sv, char *name, int (*set)(struct interpreter*, SV *, MAGIC *), int (*get)(struct interpreter*, SV *,MAGIC *)) { #endif #else # define swig_create_magic(s,a,b,c) _swig_create_magic(pPerl,s,a,b,c) static void _swig_create_magic(CPerlObj *pPerl, SV *sv, const char *name, int (CPerlObj::*set)(SV *, MAGIC *), int (CPerlObj::*get)(SV *, MAGIC *)) { #endif MAGIC *mg; sv_magic(sv,sv,'U',(char *) name,strlen(name)); mg = mg_find(sv,'U'); mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL)); mg->mg_virtual->svt_get = (SwigMagicFuncHack) get; mg->mg_virtual->svt_set = (SwigMagicFuncHack) set; mg->mg_virtual->svt_len = 0; mg->mg_virtual->svt_clear = 0; mg->mg_virtual->svt_free = 0; } #ifdef do_open #undef do_open #endif #ifdef do_close #undef do_close #endif #ifdef scalar #undef scalar #endif #ifdef list #undef list #endif #ifdef apply #undef apply #endif #ifdef convert #undef convert #endif #ifdef Error #undef Error #endif #ifdef form #undef form #endif #ifdef vform #undef vform #endif #ifdef LABEL #undef LABEL #endif #ifdef METHOD #undef METHOD #endif #ifdef Move #undef Move #endif #ifdef yylex #undef yylex #endif #ifdef yyparse #undef yyparse #endif #ifdef yyerror #undef yyerror #endif #ifdef invert #undef invert #endif #ifdef ref #undef ref #endif #ifdef ENTER #undef ENTER #endif /* -------- TYPES TABLE (BEGIN) -------- */ #define SWIGTYPE_p_arr1i swig_types[0] #define SWIGTYPE_p_fract swig_types[1] #define SWIGTYPE_p_double swig_types[2] #define SWIGTYPE_p_arr1d swig_types[3] #define SWIGTYPE_p_cmplx swig_types[4] #define SWIGTYPE_p_int swig_types[5] static swig_type_info *swig_types[7]; /* -------- TYPES TABLE (END) -------- */ #define SWIG_init boot_Math__Cephes #define SWIG_name "Math::Cephesc::boot_Math__Cephes" #define SWIG_prefix "Math::Cephesc::" #ifdef __cplusplus extern "C" #endif #ifndef PERL_OBJECT #ifndef MULTIPLICITY SWIGEXPORT(void) SWIG_init (CV* cv); #else SWIGEXPORT(void) SWIG_init (pTHXo_ CV* cv); #endif #else SWIGEXPORT(void) SWIG_init (CV *cv, CPerlObj *); #endif typedef struct { double n; double d; } fract; typedef struct { double r; double i; } cmplx; typedef double * arr1d; typedef int * arr1i; cmplx *new_cmplx(double r,double i){ cmplx *c; c = (cmplx *) malloc(sizeof(cmplx)); c->r = r; c->i = i; return c; } void delete_cmplx(cmplx *self){ free(self); } fract *new_fract(double n,double d){ fract *f; f = (fract *) malloc(sizeof(fract)); f->n = n; f->d = d; return f; } void delete_fract(fract *self){ free(self); } extern double MACHEP; extern double MAXLOG; extern double MINLOG; extern double MAXNUM; extern double PI; extern double PIO2; extern double PIO4; extern double SQRT2; extern double SQRTH; extern double LOG2E; extern double SQ2OPI; extern double LOGE2; extern double LOGSQ2; extern double THPIO4; extern double TWOOPI; extern double md_acosh(double); extern int airy(double,double *,double *,double *,double *); extern double md_asin(double); extern double md_acos(double); extern double md_asinh(double); extern double md_atan(double); extern double md_atan2(double,double); extern double md_atanh(double); extern double bdtrc(int,int,double); extern double bdtr(int,int,double); extern double bdtri(int,int,double); extern double beta(double,double); extern double lbeta(double,double); extern double btdtr(double,double,double); extern double md_cbrt(double); extern double chbevl(double,void *,int); extern double chdtrc(double,double); extern double chdtr(double,double); extern double chdtri(double,double); extern void md_clog(cmplx *,cmplx *); extern void md_cexp(cmplx *,cmplx *); extern void md_csin(cmplx *,cmplx *); extern void md_ccos(cmplx *,cmplx *); extern void md_ctan(cmplx *,cmplx *); extern void ccot(cmplx *,cmplx *); extern void md_casin(cmplx *,cmplx *); extern void md_cacos(cmplx *,cmplx *); extern void md_catan(cmplx *,cmplx *); extern void md_csinh(cmplx *,cmplx *); extern void md_casinh(cmplx *,cmplx *); extern void md_ccosh(cmplx *,cmplx *); extern void md_cacosh(cmplx *,cmplx *); extern void md_ctanh(cmplx *,cmplx *); extern void md_catanh(cmplx *,cmplx *); extern void md_cpow(cmplx *,cmplx *,cmplx *); extern void radd(fract *,fract *,fract *); extern void rsub(fract *,fract *,fract *); extern void rmul(fract *,fract *,fract *); extern void rdiv(fract *,fract *,fract *); extern double euclid(double *,double *); extern void cadd(cmplx *,cmplx *,cmplx *); extern void csub(cmplx *,cmplx *,cmplx *); extern void cmul(cmplx *,cmplx *,cmplx *); extern void cdiv(cmplx *,cmplx *,cmplx *); extern void cmov(void *,void *); extern void cneg(cmplx *); extern double md_cabs(cmplx *); extern void md_csqrt(cmplx *,cmplx *); extern double md_hypot(double,double); extern double md_cosh(double); extern double dawsn(double); extern double ellie(double,double); extern double ellik(double,double); extern double ellpe(double); extern int ellpj(double,double,double *,double *,double *,double *); extern double ellpk(double); extern double md_exp(double); extern double md_exp10(double); extern double md_exp2(double); extern double md_expn(int,double); extern double ei(double); extern double md_fabs(double); extern double fac(int); extern double fdtrc(int,int,double); extern double fdtr(int,int,double); extern double fdtri(int,int,double); extern double md_ceil(double); extern double md_floor(double); extern double md_frexp(double,int *); extern double md_ldexp(double,int); extern int fresnl(double,double *,double *); extern double md_gamma(double); extern double lgam(double); extern double gdtr(double,double,double); extern double gdtrc(double,double,double); extern double hyp2f1(double,double,double,double); extern double hyperg(double,double,double); extern double hyp2f0(double,double,double,int,double *); extern double i0(double); extern double i0e(double); extern double i1(double); extern double i1e(double); extern double igamc(double,double); extern double igam(double,double); extern double igami(double,double); extern double incbet(double,double,double); extern double incbi(double,double,double); extern double iv(double,double); extern double md_j0(double); extern double md_y0(double); extern double md_j1(double); extern double md_y1(double); extern double md_jn(int,double); extern double jv(double,double); extern double k0(double); extern double k0e(double); extern double k1(double); extern double k1e(double); extern double kn(int,double); extern double md_log(double); extern double md_log10(double); extern double md_log2(double); extern long lrand(void); extern long lsqrt(long); extern int mtherr(char *,int); extern double polevl(double,void *,int); extern double p1evl(double,void *,int); extern double nbdtrc(int,int,double); extern double nbdtr(int,int,double); extern double nbdtri(int,int,double); extern double ndtr(double); extern double md_erfc(double); extern double md_erf(double); extern double ndtri(double); extern double pdtrc(int,double); extern double pdtr(int,double); extern double pdtri(int,double); extern double md_pow(double,double); extern double md_powi(double,int); extern double psi(double); extern double rgamma(double); extern double md_round(double); extern int shichi(double,double *,double *); extern int sici(double,double *,double *); extern double md_sin(double); extern double md_cos(double); extern double radian(double,double,double); extern double md_sindg(double); extern double cosdg(double); extern double md_sinh(double); extern double spence(double); extern double sqrt(double); extern double stdtr(int,double); extern double stdtri(int,double); extern double onef2(double,double,double,double,double *); extern double threef0(double,double,double,double,double *); extern double struve(double,double); extern double md_tan(double); extern double cot(double); extern double tandg(double); extern double cotdg(double); extern double md_tanh(double); extern double md_log1p(double); extern double expm1(double); extern double cosm1(double); extern double md_yn(int,double); extern double yv(double,double); extern double zeta(double,double); extern double zetac(double); extern int drand(double *); extern double plancki(double,double); extern void polini(int); extern void polmul(arr1d,int,arr1d,int,arr1d); extern int poldiv(arr1d,int,arr1d,int,arr1d); extern void poladd(arr1d,int,arr1d,int,arr1d); extern void polsub(arr1d,int,arr1d,int,arr1d); extern void polsbt(arr1d,int,arr1d,int,arr1d); extern double poleva(arr1d,int,double); extern void polatn(arr1d,arr1d,arr1d,int); extern void polsqt(arr1d,arr1d,int); extern void polsin(arr1d,arr1d,int); extern void polcos(arr1d,arr1d,int); extern int polrt_wrap(arr1d,arr1d,int,arr1d,arr1d); extern int cpmul_wrap(arr1d,arr1d,int,arr1d,arr1d,int,arr1d,arr1d,int *); extern void fpolini(int); extern void fpolmul_wrap(arr1d,arr1d,int,arr1d,arr1d,int,arr1d,arr1d,int); extern int fpoldiv_wrap(arr1d,arr1d,int,arr1d,arr1d,int,arr1d,arr1d,int); extern void fpoladd_wrap(arr1d,arr1d,int,arr1d,arr1d,int,arr1d,arr1d,int); extern void fpolsub_wrap(arr1d,arr1d,int,arr1d,arr1d,int,arr1d,arr1d,int); extern void fpolsbt_wrap(arr1d,arr1d,int,arr1d,arr1d,int,arr1d,arr1d,int); extern void fpoleva_wrap(arr1d,arr1d,int,fract *,fract *); extern void bernum_wrap(arr1d,arr1d); extern double simpsn_wrap(arr1d,int,double); extern int minv(arr1d,arr1d,int,arr1d,arr1i); extern void mtransp(int,arr1d,arr1d); extern void eigens(arr1d,arr1d,arr1d,int); extern int simq(arr1d,arr1d,arr1d,int,int,arr1i); extern double polylog(int,double); extern double arcdot(arr1d,arr1d); extern double expx2(double,int); #ifdef PERL_OBJECT #define MAGIC_CLASS _wrap_Math::Cephes_var:: class _wrap_Math::Cephes_var : public CPerlObj { public: #else #define MAGIC_CLASS #endif SWIGCLASS_STATIC int swig_magic_readonly(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL sv = sv; mg = mg; croak("Value is read-only."); return 0; } SWIGCLASS_STATIC int _wrap_set_MACHEP(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; MACHEP = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_MACHEP(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) MACHEP); return 1; } SWIGCLASS_STATIC int _wrap_set_MAXLOG(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; MAXLOG = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_MAXLOG(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) MAXLOG); return 1; } SWIGCLASS_STATIC int _wrap_set_MINLOG(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; MINLOG = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_MINLOG(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) MINLOG); return 1; } SWIGCLASS_STATIC int _wrap_set_MAXNUM(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; MAXNUM = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_MAXNUM(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) MAXNUM); return 1; } SWIGCLASS_STATIC int _wrap_set_PI(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; PI = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_PI(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) PI); return 1; } SWIGCLASS_STATIC int _wrap_set_PIO2(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; PIO2 = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_PIO2(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) PIO2); return 1; } SWIGCLASS_STATIC int _wrap_set_PIO4(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; PIO4 = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_PIO4(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) PIO4); return 1; } SWIGCLASS_STATIC int _wrap_set_SQRT2(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; SQRT2 = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_SQRT2(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) SQRT2); return 1; } SWIGCLASS_STATIC int _wrap_set_SQRTH(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; SQRTH = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_SQRTH(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) SQRTH); return 1; } SWIGCLASS_STATIC int _wrap_set_LOG2E(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; LOG2E = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_LOG2E(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) LOG2E); return 1; } SWIGCLASS_STATIC int _wrap_set_SQ2OPI(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; SQ2OPI = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_SQ2OPI(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) SQ2OPI); return 1; } SWIGCLASS_STATIC int _wrap_set_LOGE2(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; LOGE2 = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_LOGE2(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) LOGE2); return 1; } SWIGCLASS_STATIC int _wrap_set_LOGSQ2(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; LOGSQ2 = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_LOGSQ2(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) LOGSQ2); return 1; } SWIGCLASS_STATIC int _wrap_set_THPIO4(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; THPIO4 = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_THPIO4(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) THPIO4); return 1; } SWIGCLASS_STATIC int _wrap_set_TWOOPI(pTHX_ SV* sv, MAGIC *mg) { MAGIC_PPERL mg = mg; TWOOPI = (double) SvNV(sv); return 1; } SWIGCLASS_STATIC int _wrap_val_TWOOPI(pTHX_ SV *sv, MAGIC *mg) { MAGIC_PPERL mg = mg; sv_setnv(sv, (double) TWOOPI); return 1; } #ifdef PERL_OBJECT }; #endif #ifdef __cplusplus extern "C" { #endif XS(_wrap_cmplx_r_set) { { cmplx *arg1 = (cmplx *) 0 ; double arg2 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: cmplx_r_set(self,r);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of cmplx_r_set. Expected _p_cmplx"); } } arg2 = (double) SvNV(ST(1)); if (arg1) (arg1)->r = arg2; XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cmplx_r_get) { { cmplx *arg1 = (cmplx *) 0 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: cmplx_r_get(self);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of cmplx_r_get. Expected _p_cmplx"); } } result = (double) ((arg1)->r); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cmplx_i_set) { { cmplx *arg1 = (cmplx *) 0 ; double arg2 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: cmplx_i_set(self,i);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of cmplx_i_set. Expected _p_cmplx"); } } arg2 = (double) SvNV(ST(1)); if (arg1) (arg1)->i = arg2; XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cmplx_i_get) { { cmplx *arg1 = (cmplx *) 0 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: cmplx_i_get(self);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of cmplx_i_get. Expected _p_cmplx"); } } result = (double) ((arg1)->i); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_new_cmplx) { { double arg1 = (double) 0 ; double arg2 = (double) 0 ; cmplx *result; int argvi = 0; dXSARGS; if ((items < 0) || (items > 2)) { SWIG_croak("Usage: new_cmplx(r,i);"); } if (items > 0) { arg1 = (double) SvNV(ST(0)); } if (items > 1) { arg2 = (double) SvNV(ST(1)); } result = (cmplx *)new_cmplx(arg1,arg2); ST(argvi) = sv_newmortal(); SWIG_MakePtr(ST(argvi++), (void *) result, SWIGTYPE_p_cmplx, SWIG_SHADOW|SWIG_OWNER); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_delete_cmplx) { { cmplx *arg1 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: delete_cmplx(self);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of delete_cmplx. Expected _p_cmplx"); } } delete_cmplx(arg1); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fract_n_set) { { fract *arg1 = (fract *) 0 ; double arg2 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: fract_n_set(self,n);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 1 of fract_n_set. Expected _p_fract"); } } arg2 = (double) SvNV(ST(1)); if (arg1) (arg1)->n = arg2; XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fract_n_get) { { fract *arg1 = (fract *) 0 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: fract_n_get(self);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 1 of fract_n_get. Expected _p_fract"); } } result = (double) ((arg1)->n); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fract_d_set) { { fract *arg1 = (fract *) 0 ; double arg2 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: fract_d_set(self,d);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 1 of fract_d_set. Expected _p_fract"); } } arg2 = (double) SvNV(ST(1)); if (arg1) (arg1)->d = arg2; XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fract_d_get) { { fract *arg1 = (fract *) 0 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: fract_d_get(self);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 1 of fract_d_get. Expected _p_fract"); } } result = (double) ((arg1)->d); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_new_fract) { { double arg1 = (double) 0 ; double arg2 = (double) 1 ; fract *result; int argvi = 0; dXSARGS; if ((items < 0) || (items > 2)) { SWIG_croak("Usage: new_fract(n,d);"); } if (items > 0) { arg1 = (double) SvNV(ST(0)); } if (items > 1) { arg2 = (double) SvNV(ST(1)); } result = (fract *)new_fract(arg1,arg2); ST(argvi) = sv_newmortal(); SWIG_MakePtr(ST(argvi++), (void *) result, SWIGTYPE_p_fract, SWIG_SHADOW|SWIG_OWNER); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_delete_fract) { { fract *arg1 = (fract *) 0 ; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: delete_fract(self);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 1 of delete_fract. Expected _p_fract"); } } delete_fract(arg1); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_acosh) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_acosh(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_acosh(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_airy) { { double arg1 ; double *arg2 = (double *) 0 ; double *arg3 = (double *) 0 ; double *arg4 = (double *) 0 ; double *arg5 = (double *) 0 ; int result; double temp2 ; double temp3 ; double temp4 ; double temp5 ; int argvi = 0; dXSARGS; arg2 = &temp2; arg3 = &temp3; arg4 = &temp4; arg5 = &temp5; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: airy(x);"); } arg1 = (double) SvNV(ST(0)); result = (int)airy(arg1,arg2,arg3,arg4,arg5); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg2)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg3)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg4)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg5)); argvi++; } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_asin) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_asin(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_asin(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_acos) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_acos(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_acos(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_asinh) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_asinh(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_asinh(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_atan) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_atan(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_atan(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_atan2) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_atan2(y,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)md_atan2(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_atanh) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_atanh(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_atanh(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_bdtrc) { { int arg1 ; int arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: bdtrc(k,n,p);"); } arg1 = (int) SvIV(ST(0)); arg2 = (int) SvIV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)bdtrc(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_bdtr) { { int arg1 ; int arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: bdtr(k,n,p);"); } arg1 = (int) SvIV(ST(0)); arg2 = (int) SvIV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)bdtr(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_bdtri) { { int arg1 ; int arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: bdtri(k,n,y);"); } arg1 = (int) SvIV(ST(0)); arg2 = (int) SvIV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)bdtri(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_beta) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: beta(a,b);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)beta(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_lbeta) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: lbeta(a,b);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)lbeta(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_btdtr) { { double arg1 ; double arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: btdtr(a,b,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)btdtr(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_cbrt) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_cbrt(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_cbrt(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_chbevl) { { double arg1 ; void *arg2 = (void *) 0 ; int arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: chbevl(x,P,n);"); } arg1 = (double) SvNV(ST(0)); { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, 0,0) < 0) { SWIG_croak("Type error in argument 2 of chbevl. Expected _p_void"); } } arg3 = (int) SvIV(ST(2)); result = (double)chbevl(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_chdtrc) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: chdtrc(df,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)chdtrc(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_chdtr) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: chdtr(df,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)chdtr(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_chdtri) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: chdtri(df,y);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)chdtri(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_clog) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_clog(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_clog. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_clog. Expected _p_cmplx"); } } md_clog(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_cexp) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_cexp(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_cexp. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_cexp. Expected _p_cmplx"); } } md_cexp(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_csin) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_csin(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_csin. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_csin. Expected _p_cmplx"); } } md_csin(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_ccos) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_ccos(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_ccos. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_ccos. Expected _p_cmplx"); } } md_ccos(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_ctan) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_ctan(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_ctan. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_ctan. Expected _p_cmplx"); } } md_ctan(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_ccot) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: ccot(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of ccot. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of ccot. Expected _p_cmplx"); } } ccot(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_casin) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_casin(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_casin. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_casin. Expected _p_cmplx"); } } md_casin(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_cacos) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_cacos(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_cacos. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_cacos. Expected _p_cmplx"); } } md_cacos(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_catan) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_catan(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_catan. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_catan. Expected _p_cmplx"); } } md_catan(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_csinh) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_csinh(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_csinh. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_csinh. Expected _p_cmplx"); } } md_csinh(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_casinh) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_casinh(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_casinh. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_casinh. Expected _p_cmplx"); } } md_casinh(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_ccosh) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_ccosh(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_ccosh. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_ccosh. Expected _p_cmplx"); } } md_ccosh(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_cacosh) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_cacosh(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_cacosh. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_cacosh. Expected _p_cmplx"); } } md_cacosh(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_ctanh) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_ctanh(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_ctanh. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_ctanh. Expected _p_cmplx"); } } md_ctanh(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_catanh) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_catanh(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_catanh. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_catanh. Expected _p_cmplx"); } } md_catanh(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_cpow) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; cmplx *arg3 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: md_cpow(a,z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_cpow. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_cpow. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(2), (void **) &arg3, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 3 of md_cpow. Expected _p_cmplx"); } } md_cpow(arg1,arg2,arg3); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_radd) { { fract *arg1 = (fract *) 0 ; fract *arg2 = (fract *) 0 ; fract *arg3 = (fract *) 0 ; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: radd(a,b,c);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 1 of radd. Expected _p_fract"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 2 of radd. Expected _p_fract"); } } { if (SWIG_ConvertPtr(ST(2), (void **) &arg3, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 3 of radd. Expected _p_fract"); } } radd(arg1,arg2,arg3); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_rsub) { { fract *arg1 = (fract *) 0 ; fract *arg2 = (fract *) 0 ; fract *arg3 = (fract *) 0 ; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: rsub(a,b,c);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 1 of rsub. Expected _p_fract"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 2 of rsub. Expected _p_fract"); } } { if (SWIG_ConvertPtr(ST(2), (void **) &arg3, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 3 of rsub. Expected _p_fract"); } } rsub(arg1,arg2,arg3); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_rmul) { { fract *arg1 = (fract *) 0 ; fract *arg2 = (fract *) 0 ; fract *arg3 = (fract *) 0 ; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: rmul(a,b,c);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 1 of rmul. Expected _p_fract"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 2 of rmul. Expected _p_fract"); } } { if (SWIG_ConvertPtr(ST(2), (void **) &arg3, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 3 of rmul. Expected _p_fract"); } } rmul(arg1,arg2,arg3); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_rdiv) { { fract *arg1 = (fract *) 0 ; fract *arg2 = (fract *) 0 ; fract *arg3 = (fract *) 0 ; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: rdiv(a,b,c);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 1 of rdiv. Expected _p_fract"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 2 of rdiv. Expected _p_fract"); } } { if (SWIG_ConvertPtr(ST(2), (void **) &arg3, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 3 of rdiv. Expected _p_fract"); } } rdiv(arg1,arg2,arg3); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_euclid) { { double *arg1 = (double *) 0 ; double *arg2 = (double *) 0 ; double result; double temp1 ; double temp2 ; int argvi = 0; SV * _saved[2] ; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: euclid(INOUT,INOUT);"); } { temp1 = (double) SvNV(ST(0)); arg1 = &temp1; } { temp2 = (double) SvNV(ST(1)); arg2 = &temp2; } _saved[0] = ST(0); _saved[1] = ST(1); result = (double)euclid(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg1)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg2)); argvi++; } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cadd) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; cmplx *arg3 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: cadd(a,b,c);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of cadd. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of cadd. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(2), (void **) &arg3, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 3 of cadd. Expected _p_cmplx"); } } cadd(arg1,arg2,arg3); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_csub) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; cmplx *arg3 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: csub(a,b,c);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of csub. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of csub. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(2), (void **) &arg3, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 3 of csub. Expected _p_cmplx"); } } csub(arg1,arg2,arg3); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cmul) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; cmplx *arg3 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: cmul(a,b,c);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of cmul. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of cmul. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(2), (void **) &arg3, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 3 of cmul. Expected _p_cmplx"); } } cmul(arg1,arg2,arg3); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cdiv) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; cmplx *arg3 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: cdiv(a,b,c);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of cdiv. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of cdiv. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(2), (void **) &arg3, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 3 of cdiv. Expected _p_cmplx"); } } cdiv(arg1,arg2,arg3); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cmov) { { void *arg1 = (void *) 0 ; void *arg2 = (void *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: cmov(a,b);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, 0,0) < 0) { SWIG_croak("Type error in argument 1 of cmov. Expected _p_void"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, 0,0) < 0) { SWIG_croak("Type error in argument 2 of cmov. Expected _p_void"); } } cmov(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cneg) { { cmplx *arg1 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: cneg(a);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of cneg. Expected _p_cmplx"); } } cneg(arg1); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_cabs) { { cmplx *arg1 = (cmplx *) 0 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_cabs(z);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_cabs. Expected _p_cmplx"); } } result = (double)md_cabs(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_csqrt) { { cmplx *arg1 = (cmplx *) 0 ; cmplx *arg2 = (cmplx *) 0 ; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_csqrt(z,w);"); } { if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 1 of md_csqrt. Expected _p_cmplx"); } } { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, SWIGTYPE_p_cmplx,0) < 0) { SWIG_croak("Type error in argument 2 of md_csqrt. Expected _p_cmplx"); } } md_csqrt(arg1,arg2); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_hypot) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_hypot(x,y);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)md_hypot(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_cosh) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_cosh(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_cosh(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_dawsn) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: dawsn(xx);"); } arg1 = (double) SvNV(ST(0)); result = (double)dawsn(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_ellie) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: ellie(phi,m);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)ellie(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_ellik) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: ellik(phi,m);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)ellik(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_ellpe) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: ellpe(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)ellpe(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_ellpj) { { double arg1 ; double arg2 ; double *arg3 = (double *) 0 ; double *arg4 = (double *) 0 ; double *arg5 = (double *) 0 ; double *arg6 = (double *) 0 ; int result; double temp3 ; double temp4 ; double temp5 ; double temp6 ; int argvi = 0; dXSARGS; arg3 = &temp3; arg4 = &temp4; arg5 = &temp5; arg6 = &temp6; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: ellpj(u,m);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (int)ellpj(arg1,arg2,arg3,arg4,arg5,arg6); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg3)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg4)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg5)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg6)); argvi++; } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_ellpk) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: ellpk(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)ellpk(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_exp) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_exp(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_exp(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_exp10) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_exp10(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_exp10(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_exp2) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_exp2(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_exp2(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_expn) { { int arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_expn(n,x);"); } arg1 = (int) SvIV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)md_expn(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_ei) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: ei(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)ei(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_fabs) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_fabs(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_fabs(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fac) { { int arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: fac(i);"); } arg1 = (int) SvIV(ST(0)); result = (double)fac(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fdtrc) { { int arg1 ; int arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: fdtrc(ia,ib,x);"); } arg1 = (int) SvIV(ST(0)); arg2 = (int) SvIV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)fdtrc(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fdtr) { { int arg1 ; int arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: fdtr(ia,ib,x);"); } arg1 = (int) SvIV(ST(0)); arg2 = (int) SvIV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)fdtr(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fdtri) { { int arg1 ; int arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: fdtri(ia,ib,y);"); } arg1 = (int) SvIV(ST(0)); arg2 = (int) SvIV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)fdtri(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_ceil) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_ceil(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_ceil(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_floor) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_floor(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_floor(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_frexp) { { double arg1 ; int *arg2 = (int *) 0 ; double result; int temp2 ; int argvi = 0; dXSARGS; arg2 = &temp2; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_frexp(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_frexp(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi),(IV) *(arg2)); argvi++; } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_ldexp) { { double arg1 ; int arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_ldexp(x,pw2);"); } arg1 = (double) SvNV(ST(0)); arg2 = (int) SvIV(ST(1)); result = (double)md_ldexp(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fresnl) { { double arg1 ; double *arg2 = (double *) 0 ; double *arg3 = (double *) 0 ; int result; double temp2 ; double temp3 ; int argvi = 0; dXSARGS; arg2 = &temp2; arg3 = &temp3; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: fresnl(xxa);"); } arg1 = (double) SvNV(ST(0)); result = (int)fresnl(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg2)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg3)); argvi++; } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_gamma) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_gamma(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_gamma(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_lgam) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: lgam(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)lgam(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_gdtr) { { double arg1 ; double arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: gdtr(a,b,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)gdtr(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_gdtrc) { { double arg1 ; double arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: gdtrc(a,b,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)gdtrc(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_hyp2f1) { { double arg1 ; double arg2 ; double arg3 ; double arg4 ; double result; int argvi = 0; dXSARGS; if ((items < 4) || (items > 4)) { SWIG_croak("Usage: hyp2f1(a,b,c,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); arg3 = (double) SvNV(ST(2)); arg4 = (double) SvNV(ST(3)); result = (double)hyp2f1(arg1,arg2,arg3,arg4); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_hyperg) { { double arg1 ; double arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: hyperg(a,b,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)hyperg(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_hyp2f0) { { double arg1 ; double arg2 ; double arg3 ; int arg4 ; double *arg5 = (double *) 0 ; double result; double temp5 ; int argvi = 0; dXSARGS; arg5 = &temp5; if ((items < 4) || (items > 4)) { SWIG_croak("Usage: hyp2f0(a,b,x,type);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); arg3 = (double) SvNV(ST(2)); arg4 = (int) SvIV(ST(3)); result = (double)hyp2f0(arg1,arg2,arg3,arg4,arg5); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg5)); argvi++; } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_i0) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: i0(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)i0(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_i0e) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: i0e(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)i0e(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_i1) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: i1(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)i1(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_i1e) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: i1e(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)i1e(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_igamc) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: igamc(a,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)igamc(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_igam) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: igam(a,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)igam(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_igami) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: igami(a,md_y0);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)igami(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_incbet) { { double arg1 ; double arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: incbet(aa,bb,xx);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)incbet(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_incbi) { { double arg1 ; double arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: incbi(aa,bb,yy0);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)incbi(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_iv) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: iv(v,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)iv(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_j0) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_j0(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_j0(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_y0) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_y0(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_y0(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_j1) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_j1(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_j1(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_y1) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_y1(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_y1(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_jn) { { int arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_jn(n,x);"); } arg1 = (int) SvIV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)md_jn(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_jv) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: jv(n,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)jv(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_k0) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: k0(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)k0(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_k0e) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: k0e(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)k0e(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_k1) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: k1(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)k1(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_k1e) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: k1e(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)k1e(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_kn) { { int arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: kn(nn,x);"); } arg1 = (int) SvIV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)kn(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_log) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_log(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_log(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_log10) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_log10(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_log10(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_log2) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_log2(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_log2(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_lrand) { { long result; int argvi = 0; dXSARGS; if ((items < 0) || (items > 0)) { SWIG_croak("Usage: lrand();"); } result = (long)lrand(); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_lsqrt) { { long arg1 ; long result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: lsqrt(x);"); } arg1 = (long) SvIV(ST(0)); result = (long)lsqrt(arg1); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_mtherr) { { char *arg1 ; int arg2 ; int result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: mtherr(name,code);"); } if (!SvOK((SV*) ST(0))) arg1 = 0; else arg1 = (char *) SvPV(ST(0), PL_na); arg2 = (int) SvIV(ST(1)); result = (int)mtherr(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_polevl) { { double arg1 ; void *arg2 = (void *) 0 ; int arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: polevl(x,P,N);"); } arg1 = (double) SvNV(ST(0)); { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, 0,0) < 0) { SWIG_croak("Type error in argument 2 of polevl. Expected _p_void"); } } arg3 = (int) SvIV(ST(2)); result = (double)polevl(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_p1evl) { { double arg1 ; void *arg2 = (void *) 0 ; int arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: p1evl(x,P,N);"); } arg1 = (double) SvNV(ST(0)); { if (SWIG_ConvertPtr(ST(1), (void **) &arg2, 0,0) < 0) { SWIG_croak("Type error in argument 2 of p1evl. Expected _p_void"); } } arg3 = (int) SvIV(ST(2)); result = (double)p1evl(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_nbdtrc) { { int arg1 ; int arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: nbdtrc(k,n,p);"); } arg1 = (int) SvIV(ST(0)); arg2 = (int) SvIV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)nbdtrc(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_nbdtr) { { int arg1 ; int arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: nbdtr(k,n,p);"); } arg1 = (int) SvIV(ST(0)); arg2 = (int) SvIV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)nbdtr(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_nbdtri) { { int arg1 ; int arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: nbdtri(k,n,p);"); } arg1 = (int) SvIV(ST(0)); arg2 = (int) SvIV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)nbdtri(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_ndtr) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: ndtr(a);"); } arg1 = (double) SvNV(ST(0)); result = (double)ndtr(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_erfc) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_erfc(a);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_erfc(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_erf) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_erf(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_erf(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_ndtri) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: ndtri(md_y0);"); } arg1 = (double) SvNV(ST(0)); result = (double)ndtri(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_pdtrc) { { int arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: pdtrc(k,m);"); } arg1 = (int) SvIV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)pdtrc(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_pdtr) { { int arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: pdtr(k,m);"); } arg1 = (int) SvIV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)pdtr(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_pdtri) { { int arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: pdtri(k,y);"); } arg1 = (int) SvIV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)pdtri(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_pow) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_pow(x,y);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)md_pow(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_powi) { { double arg1 ; int arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_powi(x,nn);"); } arg1 = (double) SvNV(ST(0)); arg2 = (int) SvIV(ST(1)); result = (double)md_powi(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_psi) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: psi(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)psi(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_rgamma) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: rgamma(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)rgamma(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_round) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_round(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_round(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_shichi) { { double arg1 ; double *arg2 = (double *) 0 ; double *arg3 = (double *) 0 ; int result; double temp2 ; double temp3 ; int argvi = 0; dXSARGS; arg2 = &temp2; arg3 = &temp3; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: shichi(x);"); } arg1 = (double) SvNV(ST(0)); result = (int)shichi(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg2)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg3)); argvi++; } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_sici) { { double arg1 ; double *arg2 = (double *) 0 ; double *arg3 = (double *) 0 ; int result; double temp2 ; double temp3 ; int argvi = 0; dXSARGS; arg2 = &temp2; arg3 = &temp3; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: sici(x);"); } arg1 = (double) SvNV(ST(0)); result = (int)sici(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg2)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg3)); argvi++; } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_sin) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_sin(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_sin(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_cos) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_cos(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_cos(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_radian) { { double arg1 ; double arg2 ; double arg3 ; double result; int argvi = 0; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: radian(d,m,s);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); arg3 = (double) SvNV(ST(2)); result = (double)radian(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_sindg) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_sindg(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_sindg(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cosdg) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: cosdg(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)cosdg(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_sinh) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_sinh(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_sinh(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_spence) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: spence(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)spence(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_sqrt) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: sqrt(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)sqrt(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_stdtr) { { int arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: stdtr(k,t);"); } arg1 = (int) SvIV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)stdtr(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_stdtri) { { int arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: stdtri(k,p);"); } arg1 = (int) SvIV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)stdtri(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_onef2) { { double arg1 ; double arg2 ; double arg3 ; double arg4 ; double *arg5 = (double *) 0 ; double result; double temp5 ; int argvi = 0; dXSARGS; arg5 = &temp5; if ((items < 4) || (items > 4)) { SWIG_croak("Usage: onef2(a,b,c,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); arg3 = (double) SvNV(ST(2)); arg4 = (double) SvNV(ST(3)); result = (double)onef2(arg1,arg2,arg3,arg4,arg5); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg5)); argvi++; } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_threef0) { { double arg1 ; double arg2 ; double arg3 ; double arg4 ; double *arg5 = (double *) 0 ; double result; double temp5 ; int argvi = 0; dXSARGS; arg5 = &temp5; if ((items < 4) || (items > 4)) { SWIG_croak("Usage: threef0(a,b,c,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); arg3 = (double) SvNV(ST(2)); arg4 = (double) SvNV(ST(3)); result = (double)threef0(arg1,arg2,arg3,arg4,arg5); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg5)); argvi++; } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_struve) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: struve(v,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)struve(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_tan) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_tan(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_tan(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cot) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: cot(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)cot(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_tandg) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: tandg(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)tandg(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cotdg) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: cotdg(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)cotdg(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_tanh) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_tanh(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_tanh(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_log1p) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: md_log1p(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)md_log1p(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_expm1) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: expm1(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)expm1(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cosm1) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: cosm1(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)cosm1(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_md_yn) { { int arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: md_yn(n,x);"); } arg1 = (int) SvIV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)md_yn(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_yv) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: yv(n,x);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)yv(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_zeta) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: zeta(x,q);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)zeta(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_zetac) { { double arg1 ; double result; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: zetac(x);"); } arg1 = (double) SvNV(ST(0)); result = (double)zetac(arg1); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_drand) { { double *arg1 = (double *) 0 ; int result; double temp1 ; int argvi = 0; dXSARGS; arg1 = &temp1; if ((items < 0) || (items > 0)) { SWIG_croak("Usage: drand();"); } result = (int)drand(arg1); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi),(double) *(arg1)); argvi++; } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_plancki) { { double arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: plancki(w,T);"); } arg1 = (double) SvNV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)plancki(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_polini) { { int arg1 ; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: polini(maxdeg);"); } arg1 = (int) SvIV(ST(0)); polini(arg1); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_polmul) { { arr1d arg1 ; int arg2 ; arr1d arg3 ; int arg4 ; arr1d arg5 ; int argvi = 0; SV * _saved[3] ; dXSARGS; if ((items < 5) || (items > 5)) { SWIG_croak("Usage: polmul(A,na,B,nb,C);"); } { arg1 = (double *) pack1D(ST(0),'d'); } arg2 = (int) SvIV(ST(1)); { arg3 = (double *) pack1D(ST(2),'d'); } arg4 = (int) SvIV(ST(3)); { arg5 = (double *) pack1D(ST(4),'d'); } _saved[0] = ST(0); _saved[1] = ST(2); _saved[2] = ST(4); polmul(arg1,arg2,arg3,arg4,arg5); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg3, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg5, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_poldiv) { { arr1d arg1 ; int arg2 ; arr1d arg3 ; int arg4 ; arr1d arg5 ; int result; int argvi = 0; SV * _saved[3] ; dXSARGS; if ((items < 5) || (items > 5)) { SWIG_croak("Usage: poldiv(A,na,B,nb,C);"); } { arg1 = (double *) pack1D(ST(0),'d'); } arg2 = (int) SvIV(ST(1)); { arg3 = (double *) pack1D(ST(2),'d'); } arg4 = (int) SvIV(ST(3)); { arg5 = (double *) pack1D(ST(4),'d'); } _saved[0] = ST(0); _saved[1] = ST(2); _saved[2] = ST(4); result = (int)poldiv(arg1,arg2,arg3,arg4,arg5); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg3, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg5, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_poladd) { { arr1d arg1 ; int arg2 ; arr1d arg3 ; int arg4 ; arr1d arg5 ; int argvi = 0; SV * _saved[3] ; dXSARGS; if ((items < 5) || (items > 5)) { SWIG_croak("Usage: poladd(A,na,B,nb,C);"); } { arg1 = (double *) pack1D(ST(0),'d'); } arg2 = (int) SvIV(ST(1)); { arg3 = (double *) pack1D(ST(2),'d'); } arg4 = (int) SvIV(ST(3)); { arg5 = (double *) pack1D(ST(4),'d'); } _saved[0] = ST(0); _saved[1] = ST(2); _saved[2] = ST(4); poladd(arg1,arg2,arg3,arg4,arg5); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg3, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg5, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_polsub) { { arr1d arg1 ; int arg2 ; arr1d arg3 ; int arg4 ; arr1d arg5 ; int argvi = 0; SV * _saved[3] ; dXSARGS; if ((items < 5) || (items > 5)) { SWIG_croak("Usage: polsub(A,na,B,nb,C);"); } { arg1 = (double *) pack1D(ST(0),'d'); } arg2 = (int) SvIV(ST(1)); { arg3 = (double *) pack1D(ST(2),'d'); } arg4 = (int) SvIV(ST(3)); { arg5 = (double *) pack1D(ST(4),'d'); } _saved[0] = ST(0); _saved[1] = ST(2); _saved[2] = ST(4); polsub(arg1,arg2,arg3,arg4,arg5); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg3, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg5, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_polsbt) { { arr1d arg1 ; int arg2 ; arr1d arg3 ; int arg4 ; arr1d arg5 ; int argvi = 0; SV * _saved[3] ; dXSARGS; if ((items < 5) || (items > 5)) { SWIG_croak("Usage: polsbt(A,na,B,nb,C);"); } { arg1 = (double *) pack1D(ST(0),'d'); } arg2 = (int) SvIV(ST(1)); { arg3 = (double *) pack1D(ST(2),'d'); } arg4 = (int) SvIV(ST(3)); { arg5 = (double *) pack1D(ST(4),'d'); } _saved[0] = ST(0); _saved[1] = ST(2); _saved[2] = ST(4); polsbt(arg1,arg2,arg3,arg4,arg5); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg3, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg5, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_poleva) { { arr1d arg1 ; int arg2 ; double arg3 ; double result; int argvi = 0; SV * _saved[1] ; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: poleva(A,na,x);"); } { arg1 = (double *) pack1D(ST(0),'d'); } arg2 = (int) SvIV(ST(1)); arg3 = (double) SvNV(ST(2)); _saved[0] = ST(0); result = (double)poleva(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_polatn) { { arr1d arg1 ; arr1d arg2 ; arr1d arg3 ; int arg4 ; int argvi = 0; SV * _saved[3] ; dXSARGS; if ((items < 4) || (items > 4)) { SWIG_croak("Usage: polatn(A,B,C,n);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } { arg3 = (double *) pack1D(ST(2),'d'); } arg4 = (int) SvIV(ST(3)); _saved[0] = ST(0); _saved[1] = ST(1); _saved[2] = ST(2); polatn(arg1,arg2,arg3,arg4); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg3, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_polsqt) { { arr1d arg1 ; arr1d arg2 ; int arg3 ; int argvi = 0; SV * _saved[2] ; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: polsqt(A,B,n);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } arg3 = (int) SvIV(ST(2)); _saved[0] = ST(0); _saved[1] = ST(1); polsqt(arg1,arg2,arg3); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_polsin) { { arr1d arg1 ; arr1d arg2 ; int arg3 ; int argvi = 0; SV * _saved[2] ; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: polsin(A,B,n);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } arg3 = (int) SvIV(ST(2)); _saved[0] = ST(0); _saved[1] = ST(1); polsin(arg1,arg2,arg3); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_polcos) { { arr1d arg1 ; arr1d arg2 ; int arg3 ; int argvi = 0; SV * _saved[2] ; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: polcos(A,B,n);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } arg3 = (int) SvIV(ST(2)); _saved[0] = ST(0); _saved[1] = ST(1); polcos(arg1,arg2,arg3); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_polrt_wrap) { { arr1d arg1 ; arr1d arg2 ; int arg3 ; arr1d arg4 ; arr1d arg5 ; int result; int argvi = 0; SV * _saved[4] ; dXSARGS; if ((items < 5) || (items > 5)) { SWIG_croak("Usage: polrt_wrap(xcof,cof,m,r,i);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } arg3 = (int) SvIV(ST(2)); { arg4 = (double *) pack1D(ST(3),'d'); } { arg5 = (double *) pack1D(ST(4),'d'); } _saved[0] = ST(0); _saved[1] = ST(1); _saved[2] = ST(3); _saved[3] = ST(4); result = (int)polrt_wrap(arg1,arg2,arg3,arg4,arg5); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg4, 'd', 0); } { unpack1D((SV*)_saved[3], (void *)arg5, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_cpmul_wrap) { { arr1d arg1 ; arr1d arg2 ; int arg3 ; arr1d arg4 ; arr1d arg5 ; int arg6 ; arr1d arg7 ; arr1d arg8 ; int *arg9 = (int *) 0 ; int result; int temp9 ; int argvi = 0; SV * _saved[7] ; dXSARGS; if ((items < 9) || (items > 9)) { SWIG_croak("Usage: cpmul_wrap(ar,ai,da,br,bi,db,cr,ci,INOUT);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } arg3 = (int) SvIV(ST(2)); { arg4 = (double *) pack1D(ST(3),'d'); } { arg5 = (double *) pack1D(ST(4),'d'); } arg6 = (int) SvIV(ST(5)); { arg7 = (double *) pack1D(ST(6),'d'); } { arg8 = (double *) pack1D(ST(7),'d'); } { temp9 = (int) SvIV(ST(8)); arg9 = &temp9; } _saved[0] = ST(0); _saved[1] = ST(1); _saved[2] = ST(3); _saved[3] = ST(4); _saved[4] = ST(6); _saved[5] = ST(7); _saved[6] = ST(8); result = (int)cpmul_wrap(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg4, 'd', 0); } { unpack1D((SV*)_saved[3], (void *)arg5, 'd', 0); } { unpack1D((SV*)_saved[4], (void *)arg7, 'd', 0); } { unpack1D((SV*)_saved[5], (void *)arg8, 'd', 0); } { if (argvi >= items) { EXTEND(sp,1); } ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi),(IV) *(arg9)); argvi++; } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fpolini) { { int arg1 ; int argvi = 0; dXSARGS; if ((items < 1) || (items > 1)) { SWIG_croak("Usage: fpolini(maxdeg);"); } arg1 = (int) SvIV(ST(0)); fpolini(arg1); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fpolmul_wrap) { { arr1d arg1 ; arr1d arg2 ; int arg3 ; arr1d arg4 ; arr1d arg5 ; int arg6 ; arr1d arg7 ; arr1d arg8 ; int arg9 ; int argvi = 0; SV * _saved[6] ; dXSARGS; if ((items < 9) || (items > 9)) { SWIG_croak("Usage: fpolmul_wrap(A,Ad,na,Bn,Bd,nb,Cn,Cd,nc);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } arg3 = (int) SvIV(ST(2)); { arg4 = (double *) pack1D(ST(3),'d'); } { arg5 = (double *) pack1D(ST(4),'d'); } arg6 = (int) SvIV(ST(5)); { arg7 = (double *) pack1D(ST(6),'d'); } { arg8 = (double *) pack1D(ST(7),'d'); } arg9 = (int) SvIV(ST(8)); _saved[0] = ST(0); _saved[1] = ST(1); _saved[2] = ST(3); _saved[3] = ST(4); _saved[4] = ST(6); _saved[5] = ST(7); fpolmul_wrap(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg4, 'd', 0); } { unpack1D((SV*)_saved[3], (void *)arg5, 'd', 0); } { unpack1D((SV*)_saved[4], (void *)arg7, 'd', 0); } { unpack1D((SV*)_saved[5], (void *)arg8, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fpoldiv_wrap) { { arr1d arg1 ; arr1d arg2 ; int arg3 ; arr1d arg4 ; arr1d arg5 ; int arg6 ; arr1d arg7 ; arr1d arg8 ; int arg9 ; int result; int argvi = 0; SV * _saved[6] ; dXSARGS; if ((items < 9) || (items > 9)) { SWIG_croak("Usage: fpoldiv_wrap(A,Ad,na,Bn,Bd,nb,Cn,Cd,nc);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } arg3 = (int) SvIV(ST(2)); { arg4 = (double *) pack1D(ST(3),'d'); } { arg5 = (double *) pack1D(ST(4),'d'); } arg6 = (int) SvIV(ST(5)); { arg7 = (double *) pack1D(ST(6),'d'); } { arg8 = (double *) pack1D(ST(7),'d'); } arg9 = (int) SvIV(ST(8)); _saved[0] = ST(0); _saved[1] = ST(1); _saved[2] = ST(3); _saved[3] = ST(4); _saved[4] = ST(6); _saved[5] = ST(7); result = (int)fpoldiv_wrap(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg4, 'd', 0); } { unpack1D((SV*)_saved[3], (void *)arg5, 'd', 0); } { unpack1D((SV*)_saved[4], (void *)arg7, 'd', 0); } { unpack1D((SV*)_saved[5], (void *)arg8, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fpoladd_wrap) { { arr1d arg1 ; arr1d arg2 ; int arg3 ; arr1d arg4 ; arr1d arg5 ; int arg6 ; arr1d arg7 ; arr1d arg8 ; int arg9 ; int argvi = 0; SV * _saved[6] ; dXSARGS; if ((items < 9) || (items > 9)) { SWIG_croak("Usage: fpoladd_wrap(A,Ad,na,Bn,Bd,nb,Cn,Cd,nc);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } arg3 = (int) SvIV(ST(2)); { arg4 = (double *) pack1D(ST(3),'d'); } { arg5 = (double *) pack1D(ST(4),'d'); } arg6 = (int) SvIV(ST(5)); { arg7 = (double *) pack1D(ST(6),'d'); } { arg8 = (double *) pack1D(ST(7),'d'); } arg9 = (int) SvIV(ST(8)); _saved[0] = ST(0); _saved[1] = ST(1); _saved[2] = ST(3); _saved[3] = ST(4); _saved[4] = ST(6); _saved[5] = ST(7); fpoladd_wrap(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg4, 'd', 0); } { unpack1D((SV*)_saved[3], (void *)arg5, 'd', 0); } { unpack1D((SV*)_saved[4], (void *)arg7, 'd', 0); } { unpack1D((SV*)_saved[5], (void *)arg8, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fpolsub_wrap) { { arr1d arg1 ; arr1d arg2 ; int arg3 ; arr1d arg4 ; arr1d arg5 ; int arg6 ; arr1d arg7 ; arr1d arg8 ; int arg9 ; int argvi = 0; SV * _saved[6] ; dXSARGS; if ((items < 9) || (items > 9)) { SWIG_croak("Usage: fpolsub_wrap(A,Ad,na,Bn,Bd,nb,Cn,Cd,nc);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } arg3 = (int) SvIV(ST(2)); { arg4 = (double *) pack1D(ST(3),'d'); } { arg5 = (double *) pack1D(ST(4),'d'); } arg6 = (int) SvIV(ST(5)); { arg7 = (double *) pack1D(ST(6),'d'); } { arg8 = (double *) pack1D(ST(7),'d'); } arg9 = (int) SvIV(ST(8)); _saved[0] = ST(0); _saved[1] = ST(1); _saved[2] = ST(3); _saved[3] = ST(4); _saved[4] = ST(6); _saved[5] = ST(7); fpolsub_wrap(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg4, 'd', 0); } { unpack1D((SV*)_saved[3], (void *)arg5, 'd', 0); } { unpack1D((SV*)_saved[4], (void *)arg7, 'd', 0); } { unpack1D((SV*)_saved[5], (void *)arg8, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fpolsbt_wrap) { { arr1d arg1 ; arr1d arg2 ; int arg3 ; arr1d arg4 ; arr1d arg5 ; int arg6 ; arr1d arg7 ; arr1d arg8 ; int arg9 ; int argvi = 0; SV * _saved[6] ; dXSARGS; if ((items < 9) || (items > 9)) { SWIG_croak("Usage: fpolsbt_wrap(A,Ad,na,Bn,Bd,nb,Cn,Cd,nc);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } arg3 = (int) SvIV(ST(2)); { arg4 = (double *) pack1D(ST(3),'d'); } { arg5 = (double *) pack1D(ST(4),'d'); } arg6 = (int) SvIV(ST(5)); { arg7 = (double *) pack1D(ST(6),'d'); } { arg8 = (double *) pack1D(ST(7),'d'); } arg9 = (int) SvIV(ST(8)); _saved[0] = ST(0); _saved[1] = ST(1); _saved[2] = ST(3); _saved[3] = ST(4); _saved[4] = ST(6); _saved[5] = ST(7); fpolsbt_wrap(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg4, 'd', 0); } { unpack1D((SV*)_saved[3], (void *)arg5, 'd', 0); } { unpack1D((SV*)_saved[4], (void *)arg7, 'd', 0); } { unpack1D((SV*)_saved[5], (void *)arg8, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_fpoleva_wrap) { { arr1d arg1 ; arr1d arg2 ; int arg3 ; fract *arg4 = (fract *) 0 ; fract *arg5 = (fract *) 0 ; int argvi = 0; SV * _saved[2] ; dXSARGS; if ((items < 5) || (items > 5)) { SWIG_croak("Usage: fpoleva_wrap(An,Ad,na,x,s);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } arg3 = (int) SvIV(ST(2)); { if (SWIG_ConvertPtr(ST(3), (void **) &arg4, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 4 of fpoleva_wrap. Expected _p_fract"); } } { if (SWIG_ConvertPtr(ST(4), (void **) &arg5, SWIGTYPE_p_fract,0) < 0) { SWIG_croak("Type error in argument 5 of fpoleva_wrap. Expected _p_fract"); } } _saved[0] = ST(0); _saved[1] = ST(1); fpoleva_wrap(arg1,arg2,arg3,arg4,arg5); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_bernum_wrap) { { arr1d arg1 ; arr1d arg2 ; int argvi = 0; SV * _saved[2] ; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: bernum_wrap(num,den);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } _saved[0] = ST(0); _saved[1] = ST(1); bernum_wrap(arg1,arg2); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_simpsn_wrap) { { arr1d arg1 ; int arg2 ; double arg3 ; double result; int argvi = 0; SV * _saved[1] ; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: simpsn_wrap(f,n,h);"); } { arg1 = (double *) pack1D(ST(0),'d'); } arg2 = (int) SvIV(ST(1)); arg3 = (double) SvNV(ST(2)); _saved[0] = ST(0); result = (double)simpsn_wrap(arg1,arg2,arg3); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_minv) { { arr1d arg1 ; arr1d arg2 ; int arg3 ; arr1d arg4 ; arr1i arg5 ; int result; int argvi = 0; SV * _saved[4] ; dXSARGS; if ((items < 5) || (items > 5)) { SWIG_croak("Usage: minv(A,X,n,B,IPS);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } arg3 = (int) SvIV(ST(2)); { arg4 = (double *) pack1D(ST(3),'d'); } { arg5 = (int *) pack1D(ST(4),'i'); } _saved[0] = ST(0); _saved[1] = ST(1); _saved[2] = ST(3); _saved[3] = ST(4); result = (int)minv(arg1,arg2,arg3,arg4,arg5); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg4, 'd', 0); } { unpack1D((SV*)_saved[3], (void *)arg5, 'i', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_mtransp) { { int arg1 ; arr1d arg2 ; arr1d arg3 ; int argvi = 0; SV * _saved[2] ; dXSARGS; if ((items < 3) || (items > 3)) { SWIG_croak("Usage: mtransp(n,A,X);"); } arg1 = (int) SvIV(ST(0)); { arg2 = (double *) pack1D(ST(1),'d'); } { arg3 = (double *) pack1D(ST(2),'d'); } _saved[0] = ST(1); _saved[1] = ST(2); mtransp(arg1,arg2,arg3); { unpack1D((SV*)_saved[0], (void *)arg2, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg3, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_eigens) { { arr1d arg1 ; arr1d arg2 ; arr1d arg3 ; int arg4 ; int argvi = 0; SV * _saved[3] ; dXSARGS; if ((items < 4) || (items > 4)) { SWIG_croak("Usage: eigens(A,EV,E,n);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } { arg3 = (double *) pack1D(ST(2),'d'); } arg4 = (int) SvIV(ST(3)); _saved[0] = ST(0); _saved[1] = ST(1); _saved[2] = ST(2); eigens(arg1,arg2,arg3,arg4); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg3, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_simq) { { arr1d arg1 ; arr1d arg2 ; arr1d arg3 ; int arg4 ; int arg5 ; arr1i arg6 ; int result; int argvi = 0; SV * _saved[4] ; dXSARGS; if ((items < 6) || (items > 6)) { SWIG_croak("Usage: simq(A,B,X,n,flag,IPS);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } { arg3 = (double *) pack1D(ST(2),'d'); } arg4 = (int) SvIV(ST(3)); arg5 = (int) SvIV(ST(4)); { arg6 = (int *) pack1D(ST(5),'i'); } _saved[0] = ST(0); _saved[1] = ST(1); _saved[2] = ST(2); _saved[3] = ST(5); result = (int)simq(arg1,arg2,arg3,arg4,arg5,arg6); ST(argvi) = sv_newmortal(); sv_setiv(ST(argvi++), (IV) result); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } { unpack1D((SV*)_saved[2], (void *)arg3, 'd', 0); } { unpack1D((SV*)_saved[3], (void *)arg6, 'i', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_polylog) { { int arg1 ; double arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: polylog(n,x);"); } arg1 = (int) SvIV(ST(0)); arg2 = (double) SvNV(ST(1)); result = (double)polylog(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_arcdot) { { arr1d arg1 ; arr1d arg2 ; double result; int argvi = 0; SV * _saved[2] ; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: arcdot(p,q);"); } { arg1 = (double *) pack1D(ST(0),'d'); } { arg2 = (double *) pack1D(ST(1),'d'); } _saved[0] = ST(0); _saved[1] = ST(1); result = (double)arcdot(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); { unpack1D((SV*)_saved[0], (void *)arg1, 'd', 0); } { unpack1D((SV*)_saved[1], (void *)arg2, 'd', 0); } XSRETURN(argvi); fail: ; } croak(Nullch); } XS(_wrap_expx2) { { double arg1 ; int arg2 ; double result; int argvi = 0; dXSARGS; if ((items < 2) || (items > 2)) { SWIG_croak("Usage: expx2(x,sign);"); } arg1 = (double) SvNV(ST(0)); arg2 = (int) SvIV(ST(1)); result = (double)expx2(arg1,arg2); ST(argvi) = sv_newmortal(); sv_setnv(ST(argvi++), (double) result); XSRETURN(argvi); fail: ; } croak(Nullch); } /* -------- TYPE CONVERSION AND EQUIVALENCE RULES (BEGIN) -------- */ static swig_type_info _swigt__p_arr1i[] = {{"_p_arr1i", 0, "arr1i *", 0},{"_p_arr1i"},{0}}; static swig_type_info _swigt__p_fract[] = {{"Math::Cephes::Fraction", 0, "fract *", 0},{"Math::Cephes::Fraction"},{0}}; static swig_type_info _swigt__p_double[] = {{"_p_double", 0, "double *", 0},{"_p_double"},{0}}; static swig_type_info _swigt__p_arr1d[] = {{"_p_arr1d", 0, "arr1d *", 0},{"_p_arr1d"},{0}}; static swig_type_info _swigt__p_cmplx[] = {{"Math::Cephes::Complex", 0, "cmplx *", 0},{"Math::Cephes::Complex"},{0}}; static swig_type_info _swigt__p_int[] = {{"_p_int", 0, "int *", 0},{"_p_int"},{0}}; static swig_type_info *swig_types_initial[] = { _swigt__p_arr1i, _swigt__p_fract, _swigt__p_double, _swigt__p_arr1d, _swigt__p_cmplx, _swigt__p_int, 0 }; /* -------- TYPE CONVERSION AND EQUIVALENCE RULES (END) -------- */ static swig_constant_info swig_constants[] = { {0} }; #ifdef __cplusplus } #endif static swig_variable_info swig_variables[] = { { "Math::Cephesc::MACHEP", MAGIC_CLASS _wrap_set_MACHEP, MAGIC_CLASS _wrap_val_MACHEP,0 }, { "Math::Cephesc::MAXLOG", MAGIC_CLASS _wrap_set_MAXLOG, MAGIC_CLASS _wrap_val_MAXLOG,0 }, { "Math::Cephesc::MINLOG", MAGIC_CLASS _wrap_set_MINLOG, MAGIC_CLASS _wrap_val_MINLOG,0 }, { "Math::Cephesc::MAXNUM", MAGIC_CLASS _wrap_set_MAXNUM, MAGIC_CLASS _wrap_val_MAXNUM,0 }, { "Math::Cephesc::PI", MAGIC_CLASS _wrap_set_PI, MAGIC_CLASS _wrap_val_PI,0 }, { "Math::Cephesc::PIO2", MAGIC_CLASS _wrap_set_PIO2, MAGIC_CLASS _wrap_val_PIO2,0 }, { "Math::Cephesc::PIO4", MAGIC_CLASS _wrap_set_PIO4, MAGIC_CLASS _wrap_val_PIO4,0 }, { "Math::Cephesc::SQRT2", MAGIC_CLASS _wrap_set_SQRT2, MAGIC_CLASS _wrap_val_SQRT2,0 }, { "Math::Cephesc::SQRTH", MAGIC_CLASS _wrap_set_SQRTH, MAGIC_CLASS _wrap_val_SQRTH,0 }, { "Math::Cephesc::LOG2E", MAGIC_CLASS _wrap_set_LOG2E, MAGIC_CLASS _wrap_val_LOG2E,0 }, { "Math::Cephesc::SQ2OPI", MAGIC_CLASS _wrap_set_SQ2OPI, MAGIC_CLASS _wrap_val_SQ2OPI,0 }, { "Math::Cephesc::LOGE2", MAGIC_CLASS _wrap_set_LOGE2, MAGIC_CLASS _wrap_val_LOGE2,0 }, { "Math::Cephesc::LOGSQ2", MAGIC_CLASS _wrap_set_LOGSQ2, MAGIC_CLASS _wrap_val_LOGSQ2,0 }, { "Math::Cephesc::THPIO4", MAGIC_CLASS _wrap_set_THPIO4, MAGIC_CLASS _wrap_val_THPIO4,0 }, { "Math::Cephesc::TWOOPI", MAGIC_CLASS _wrap_set_TWOOPI, MAGIC_CLASS _wrap_val_TWOOPI,0 }, {0} }; static swig_command_info swig_commands[] = { {"Math::Cephesc::cmplx_r_set", _wrap_cmplx_r_set}, {"Math::Cephesc::cmplx_r_get", _wrap_cmplx_r_get}, {"Math::Cephesc::cmplx_i_set", _wrap_cmplx_i_set}, {"Math::Cephesc::cmplx_i_get", _wrap_cmplx_i_get}, {"Math::Cephesc::new_cmplx", _wrap_new_cmplx}, {"Math::Cephesc::delete_cmplx", _wrap_delete_cmplx}, {"Math::Cephesc::fract_n_set", _wrap_fract_n_set}, {"Math::Cephesc::fract_n_get", _wrap_fract_n_get}, {"Math::Cephesc::fract_d_set", _wrap_fract_d_set}, {"Math::Cephesc::fract_d_get", _wrap_fract_d_get}, {"Math::Cephesc::new_fract", _wrap_new_fract}, {"Math::Cephesc::delete_fract", _wrap_delete_fract}, {"Math::Cephesc::md_acosh", _wrap_md_acosh}, {"Math::Cephesc::airy", _wrap_airy}, {"Math::Cephesc::md_asin", _wrap_md_asin}, {"Math::Cephesc::md_acos", _wrap_md_acos}, {"Math::Cephesc::md_asinh", _wrap_md_asinh}, {"Math::Cephesc::md_atan", _wrap_md_atan}, {"Math::Cephesc::md_atan2", _wrap_md_atan2}, {"Math::Cephesc::md_atanh", _wrap_md_atanh}, {"Math::Cephesc::bdtrc", _wrap_bdtrc}, {"Math::Cephesc::bdtr", _wrap_bdtr}, {"Math::Cephesc::bdtri", _wrap_bdtri}, {"Math::Cephesc::beta", _wrap_beta}, {"Math::Cephesc::lbeta", _wrap_lbeta}, {"Math::Cephesc::btdtr", _wrap_btdtr}, {"Math::Cephesc::md_cbrt", _wrap_md_cbrt}, {"Math::Cephesc::chbevl", _wrap_chbevl}, {"Math::Cephesc::chdtrc", _wrap_chdtrc}, {"Math::Cephesc::chdtr", _wrap_chdtr}, {"Math::Cephesc::chdtri", _wrap_chdtri}, {"Math::Cephesc::md_clog", _wrap_md_clog}, {"Math::Cephesc::md_cexp", _wrap_md_cexp}, {"Math::Cephesc::md_csin", _wrap_md_csin}, {"Math::Cephesc::md_ccos", _wrap_md_ccos}, {"Math::Cephesc::md_ctan", _wrap_md_ctan}, {"Math::Cephesc::ccot", _wrap_ccot}, {"Math::Cephesc::md_casin", _wrap_md_casin}, {"Math::Cephesc::md_cacos", _wrap_md_cacos}, {"Math::Cephesc::md_catan", _wrap_md_catan}, {"Math::Cephesc::md_csinh", _wrap_md_csinh}, {"Math::Cephesc::md_casinh", _wrap_md_casinh}, {"Math::Cephesc::md_ccosh", _wrap_md_ccosh}, {"Math::Cephesc::md_cacosh", _wrap_md_cacosh}, {"Math::Cephesc::md_ctanh", _wrap_md_ctanh}, {"Math::Cephesc::md_catanh", _wrap_md_catanh}, {"Math::Cephesc::md_cpow", _wrap_md_cpow}, {"Math::Cephesc::radd", _wrap_radd}, {"Math::Cephesc::rsub", _wrap_rsub}, {"Math::Cephesc::rmul", _wrap_rmul}, {"Math::Cephesc::rdiv", _wrap_rdiv}, {"Math::Cephesc::euclid", _wrap_euclid}, {"Math::Cephesc::cadd", _wrap_cadd}, {"Math::Cephesc::csub", _wrap_csub}, {"Math::Cephesc::cmul", _wrap_cmul}, {"Math::Cephesc::cdiv", _wrap_cdiv}, {"Math::Cephesc::cmov", _wrap_cmov}, {"Math::Cephesc::cneg", _wrap_cneg}, {"Math::Cephesc::md_cabs", _wrap_md_cabs}, {"Math::Cephesc::md_csqrt", _wrap_md_csqrt}, {"Math::Cephesc::md_hypot", _wrap_md_hypot}, {"Math::Cephesc::md_cosh", _wrap_md_cosh}, {"Math::Cephesc::dawsn", _wrap_dawsn}, {"Math::Cephesc::ellie", _wrap_ellie}, {"Math::Cephesc::ellik", _wrap_ellik}, {"Math::Cephesc::ellpe", _wrap_ellpe}, {"Math::Cephesc::ellpj", _wrap_ellpj}, {"Math::Cephesc::ellpk", _wrap_ellpk}, {"Math::Cephesc::md_exp", _wrap_md_exp}, {"Math::Cephesc::md_exp10", _wrap_md_exp10}, {"Math::Cephesc::md_exp2", _wrap_md_exp2}, {"Math::Cephesc::md_expn", _wrap_md_expn}, {"Math::Cephesc::ei", _wrap_ei}, {"Math::Cephesc::md_fabs", _wrap_md_fabs}, {"Math::Cephesc::fac", _wrap_fac}, {"Math::Cephesc::fdtrc", _wrap_fdtrc}, {"Math::Cephesc::fdtr", _wrap_fdtr}, {"Math::Cephesc::fdtri", _wrap_fdtri}, {"Math::Cephesc::md_ceil", _wrap_md_ceil}, {"Math::Cephesc::md_floor", _wrap_md_floor}, {"Math::Cephesc::md_frexp", _wrap_md_frexp}, {"Math::Cephesc::md_ldexp", _wrap_md_ldexp}, {"Math::Cephesc::fresnl", _wrap_fresnl}, {"Math::Cephesc::md_gamma", _wrap_md_gamma}, {"Math::Cephesc::lgam", _wrap_lgam}, {"Math::Cephesc::gdtr", _wrap_gdtr}, {"Math::Cephesc::gdtrc", _wrap_gdtrc}, {"Math::Cephesc::hyp2f1", _wrap_hyp2f1}, {"Math::Cephesc::hyperg", _wrap_hyperg}, {"Math::Cephesc::hyp2f0", _wrap_hyp2f0}, {"Math::Cephesc::i0", _wrap_i0}, {"Math::Cephesc::i0e", _wrap_i0e}, {"Math::Cephesc::i1", _wrap_i1}, {"Math::Cephesc::i1e", _wrap_i1e}, {"Math::Cephesc::igamc", _wrap_igamc}, {"Math::Cephesc::igam", _wrap_igam}, {"Math::Cephesc::igami", _wrap_igami}, {"Math::Cephesc::incbet", _wrap_incbet}, {"Math::Cephesc::incbi", _wrap_incbi}, {"Math::Cephesc::iv", _wrap_iv}, {"Math::Cephesc::md_j0", _wrap_md_j0}, {"Math::Cephesc::md_y0", _wrap_md_y0}, {"Math::Cephesc::md_j1", _wrap_md_j1}, {"Math::Cephesc::md_y1", _wrap_md_y1}, {"Math::Cephesc::md_jn", _wrap_md_jn}, {"Math::Cephesc::jv", _wrap_jv}, {"Math::Cephesc::k0", _wrap_k0}, {"Math::Cephesc::k0e", _wrap_k0e}, {"Math::Cephesc::k1", _wrap_k1}, {"Math::Cephesc::k1e", _wrap_k1e}, {"Math::Cephesc::kn", _wrap_kn}, {"Math::Cephesc::md_log", _wrap_md_log}, {"Math::Cephesc::md_log10", _wrap_md_log10}, {"Math::Cephesc::md_log2", _wrap_md_log2}, {"Math::Cephesc::lrand", _wrap_lrand}, {"Math::Cephesc::lsqrt", _wrap_lsqrt}, {"Math::Cephesc::mtherr", _wrap_mtherr}, {"Math::Cephesc::polevl", _wrap_polevl}, {"Math::Cephesc::p1evl", _wrap_p1evl}, {"Math::Cephesc::nbdtrc", _wrap_nbdtrc}, {"Math::Cephesc::nbdtr", _wrap_nbdtr}, {"Math::Cephesc::nbdtri", _wrap_nbdtri}, {"Math::Cephesc::ndtr", _wrap_ndtr}, {"Math::Cephesc::md_erfc", _wrap_md_erfc}, {"Math::Cephesc::md_erf", _wrap_md_erf}, {"Math::Cephesc::ndtri", _wrap_ndtri}, {"Math::Cephesc::pdtrc", _wrap_pdtrc}, {"Math::Cephesc::pdtr", _wrap_pdtr}, {"Math::Cephesc::pdtri", _wrap_pdtri}, {"Math::Cephesc::md_pow", _wrap_md_pow}, {"Math::Cephesc::md_powi", _wrap_md_powi}, {"Math::Cephesc::psi", _wrap_psi}, {"Math::Cephesc::rgamma", _wrap_rgamma}, {"Math::Cephesc::md_round", _wrap_md_round}, {"Math::Cephesc::shichi", _wrap_shichi}, {"Math::Cephesc::sici", _wrap_sici}, {"Math::Cephesc::md_sin", _wrap_md_sin}, {"Math::Cephesc::md_cos", _wrap_md_cos}, {"Math::Cephesc::radian", _wrap_radian}, {"Math::Cephesc::md_sindg", _wrap_md_sindg}, {"Math::Cephesc::cosdg", _wrap_cosdg}, {"Math::Cephesc::md_sinh", _wrap_md_sinh}, {"Math::Cephesc::spence", _wrap_spence}, {"Math::Cephesc::sqrt", _wrap_sqrt}, {"Math::Cephesc::stdtr", _wrap_stdtr}, {"Math::Cephesc::stdtri", _wrap_stdtri}, {"Math::Cephesc::onef2", _wrap_onef2}, {"Math::Cephesc::threef0", _wrap_threef0}, {"Math::Cephesc::struve", _wrap_struve}, {"Math::Cephesc::md_tan", _wrap_md_tan}, {"Math::Cephesc::cot", _wrap_cot}, {"Math::Cephesc::tandg", _wrap_tandg}, {"Math::Cephesc::cotdg", _wrap_cotdg}, {"Math::Cephesc::md_tanh", _wrap_md_tanh}, {"Math::Cephesc::md_log1p", _wrap_md_log1p}, {"Math::Cephesc::expm1", _wrap_expm1}, {"Math::Cephesc::cosm1", _wrap_cosm1}, {"Math::Cephesc::md_yn", _wrap_md_yn}, {"Math::Cephesc::yv", _wrap_yv}, {"Math::Cephesc::zeta", _wrap_zeta}, {"Math::Cephesc::zetac", _wrap_zetac}, {"Math::Cephesc::drand", _wrap_drand}, {"Math::Cephesc::plancki", _wrap_plancki}, {"Math::Cephesc::polini", _wrap_polini}, {"Math::Cephesc::polmul", _wrap_polmul}, {"Math::Cephesc::poldiv", _wrap_poldiv}, {"Math::Cephesc::poladd", _wrap_poladd}, {"Math::Cephesc::polsub", _wrap_polsub}, {"Math::Cephesc::polsbt", _wrap_polsbt}, {"Math::Cephesc::poleva", _wrap_poleva}, {"Math::Cephesc::polatn", _wrap_polatn}, {"Math::Cephesc::polsqt", _wrap_polsqt}, {"Math::Cephesc::polsin", _wrap_polsin}, {"Math::Cephesc::polcos", _wrap_polcos}, {"Math::Cephesc::polrt_wrap", _wrap_polrt_wrap}, {"Math::Cephesc::cpmul_wrap", _wrap_cpmul_wrap}, {"Math::Cephesc::fpolini", _wrap_fpolini}, {"Math::Cephesc::fpolmul_wrap", _wrap_fpolmul_wrap}, {"Math::Cephesc::fpoldiv_wrap", _wrap_fpoldiv_wrap}, {"Math::Cephesc::fpoladd_wrap", _wrap_fpoladd_wrap}, {"Math::Cephesc::fpolsub_wrap", _wrap_fpolsub_wrap}, {"Math::Cephesc::fpolsbt_wrap", _wrap_fpolsbt_wrap}, {"Math::Cephesc::fpoleva_wrap", _wrap_fpoleva_wrap}, {"Math::Cephesc::bernum_wrap", _wrap_bernum_wrap}, {"Math::Cephesc::simpsn_wrap", _wrap_simpsn_wrap}, {"Math::Cephesc::minv", _wrap_minv}, {"Math::Cephesc::mtransp", _wrap_mtransp}, {"Math::Cephesc::eigens", _wrap_eigens}, {"Math::Cephesc::simq", _wrap_simq}, {"Math::Cephesc::polylog", _wrap_polylog}, {"Math::Cephesc::arcdot", _wrap_arcdot}, {"Math::Cephesc::expx2", _wrap_expx2}, {0,0} }; #ifdef __cplusplus extern "C" #endif XS(SWIG_init) { dXSARGS; int i; static int _init = 0; if (!_init) { for (i = 0; swig_types_initial[i]; i++) { swig_types[i] = SWIG_TypeRegister(swig_types_initial[i]); } _init = 1; } /* Install commands */ for (i = 0; swig_commands[i].name; i++) { newXS((char*) swig_commands[i].name,swig_commands[i].wrapper, (char*)__FILE__); } /* Install variables */ for (i = 0; swig_variables[i].name; i++) { SV *sv; sv = perl_get_sv((char*) swig_variables[i].name, TRUE | 0x2); if (swig_variables[i].type) { SWIG_MakePtr(sv,(void *)1, *swig_variables[i].type,0); } else { sv_setiv(sv,(IV) 0); } swig_create_magic(sv, (char *) swig_variables[i].name, swig_variables[i].set, swig_variables[i].get); } /* Install constant */ for (i = 0; swig_constants[i].type; i++) { SV *sv; sv = perl_get_sv((char*)swig_constants[i].name, TRUE | 0x2); switch(swig_constants[i].type) { case SWIG_INT: sv_setiv(sv, (IV) swig_constants[i].lvalue); break; case SWIG_FLOAT: sv_setnv(sv, (double) swig_constants[i].dvalue); break; case SWIG_STRING: sv_setpv(sv, (char *) swig_constants[i].pvalue); break; case SWIG_POINTER: SWIG_MakePtr(sv, swig_constants[i].pvalue, *(swig_constants[i].ptype),0); break; case SWIG_BINARY: SWIG_MakePackedObj(sv, swig_constants[i].pvalue, swig_constants[i].lvalue, *(swig_constants[i].ptype)); break; default: break; } SvREADONLY_on(sv); } SWIG_TypeClientData(SWIGTYPE_p_cmplx, (void*) "Math::Cephes::cmplx"); SWIG_TypeClientData(SWIGTYPE_p_fract, (void*) "Math::Cephes::fract"); ST(0) = &PL_sv_yes; XSRETURN(1); } Math-Cephes-0.5306/scripts/0000755000175000017500000000000014757250372015274 5ustar shlomifshlomifMath-Cephes-0.5306/scripts/bump-version-number.pl0000644000175000017500000000112614757122741021543 0ustar shlomifshlomif#!/usr/bin/perl use strict; use warnings; use File::Find::Object (); use Path::Tiny qw/ path /; my $tree = File::Find::Object->new( {}, 'lib/' ); my $version_n = shift(@ARGV); if ( !defined($version_n) ) { die "Specify version number as an argument! bump-version-number.pl '0.0.1'"; } while ( my $r = $tree->next() ) { if ( $r =~ m{/\.svn\z} ) { $tree->prune(); } elsif ( $r =~ m{\.pm\z} ) { path($r)->edit_lines_utf8( sub { s#(\$VERSION = '|^Version )\d+\.\d+(?:\.\d+)?('|)#$1 . $version_n . $2#e; } ); } } Math-Cephes-0.5306/META.json0000644000175000017500000000203614757250372015227 0ustar shlomifshlomif{ "abstract" : "Perl interface to the math cephes library", "author" : [ "Shlomi Fish " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Math-Cephes", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "perl" : "5.008" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "https://github.com/shlomif/Math-Cephes" } }, "version" : "0.5306", "x_serialization_backend" : "JSON::PP version 4.16" } Math-Cephes-0.5306/LICENSE0000644000175000017500000005013114757021403014601 0ustar shlomifshlomifTerms of Perl itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" ---------------------------------------------------------------------------- GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS ---------------------------------------------------------------------------- The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Math-Cephes-0.5306/pmath0000644000175000017500000024112014757021403014630 0ustar shlomifshlomif#!/usr/bin/perl use Config; use Carp; use Term::ReadLine; use Math::Cephes qw(:all); use Math::Cephes::Complex qw(cmplx); use Math::Cephes::Fraction qw(:fract); use strict; use vars qw($attribs %topics @pagers @topics %desc $lines_max $last_result); $lines_max = $ENV{LINES} || 20; search_pagers(); get_topics(); get_descs(); @topics = sort keys %topics; my $term = Term::ReadLine->new('Math::Cephes interface'); my $rl_package = $term->ReadLine; my $prompt = "pmath> "; my $OUT = $term->OUT || ''; select $OUT; my ($rl_avail); if ($rl_package eq "Term::ReadLine::Gnu") { $attribs = $term->Attribs; $attribs->{'attempted_completion_function'} = \&gnu_cpl; $attribs->{'completion_entry_function'} = $attribs->{'list_completion_function'}; $rl_avail = 'enabled'; } else { $readline::rl_completion_function = 'main::cpl'; if ($rl_package eq 'Term::ReadLine::Perl' || $rl_package eq 'Term::ReadLine::readline_pl') { $rl_avail = 'enabled'; } else { $rl_avail = "available (get Term::ReadKey and" . " Term::ReadLine::[Perl|GNU])"; } } print <<"END"; Interactive interface to the Math::Cephes module. TermReadLine $rl_avail. Type 'help' or '?' for help. END my $prec = 6; my $flag = 0; my $expression = ''; while ( defined ($_ = $term->readline($prompt)) ) { last if /^\s*(quit|exit|q)\s*$/; if ( s!\\\s*$!!) { $expression .= $_; $flag = 1; $prompt = " "; next; } my @res; if ($flag) { { no strict; $expression .= $_; @res = eval ($expression); } warn $@ if $@; if (! $@) { $last_result = $res[0] if @res == 1; print_res(@res); } $flag = 0; $prompt = "pmath> "; $expression = ''; next; } if (m!;\s*\S+.*;\s*!) { { no strict; @res = eval($_); } warn $@ if $@; if (! $@) { $last_result = $res[0] if @res == 1; print_res(@res); } next; } s/^\s*(\?)/help /; s/;\s*$//; if (/^\s*(help)\s+/) { help($_); next; } if (/^\s*setprec/) { set_prec($_); next; } if (/%/) { s/%/$last_result/; } if (/^mixed/) { print "\t", $last_result->as_mixed_string, "\n"; next; } { no strict; @res = eval($_), "\n"; } warn $@ if $@; if (! $@) { $last_result = $res[0] if @res == 1; print_res(@res); } $term->addhistory($_) if /\S/; } sub set_prec { my $arg = shift; ($prec = $arg) =~ s!^\s*setprec(\s*\(|\s+)(\d+).*!$2!; if ($prec =~ /\D+/) { print "\nPlease enter a positive integer for setprec\n"; $prec = 6; } else { print "\tdisplay set to $prec decimal places\n"; } } sub print_res { my @results = @_; foreach my $res (@results) { next if (@results == 1 and $res == 1); if ($res =~ m!^[+-\d]+$!) { print sprintf("\t%d ", $res); } elsif ($res =~ m!^[+\-\d\.]+$!) { my $length = length(int($res)) + $prec + 2; print sprintf("\t%$length.${prec}f ", $res); } elsif ($res =~ m!^[+\-\d\.e]+$!) { my $length = $prec + 6; print sprintf("\t%$length.${prec}e ", $res); } else { if (ref($res) =~ /^Math::Cephes/) { print "\t", $res->as_string, "\n"; } else { print "\t", $res; } } } print "\n"; } sub help { my $param = shift; (my $topic = $param) =~ s!^\s*(help)\s+!!; if (!$topic) { foreach my $pager (@pagers) { open (PAGER, "| $pager") or next; print PAGER <<"END"; Enter an expression to be evaluated, or 'q' to quit. Use 'setprec j' to display 'j' decimal places. '%' gives the last (successful) evaluated result. Type 'help function_name' for help on a particular function, or 'help group_name' for a list of functions grouped as follows: constants: useful constants trigs: various trigonometric functions hypers: various hyperbolic functions explog: various exponentiation and logarithmic functions complex: some functions to manipulate complex numbers fract: some functions to evaluate fractions utils: various utilities bessels: various Bessel functions dists: various distribution functions gammas: various gamma functions betas: various beta functions elliptics: various elliptic functions hypergeometrics: some hypergeometric functions misc: miscellaneous functions END close(PAGER) or next; last; } } else { $topic =~ s!^\s*(.*?)\s*$!$1!; if ($topics{$topic}) { my $lines = $topics{$topic} =~ tr/\n//; if ($lines > $lines_max) { foreach my $pager (@pagers) { open (PAGER, "| $pager") or next; print PAGER $topics{$topic}; print PAGER "\n"; close(PAGER) or next; last; } } else { print $topics{$topic}, "\n"; } } else { print "\nSorry - no help is available on $topic\n"; } } return; } sub get_topics { my $help = << 'END'; Type "help topic" to get help on a particular topic. END my $setprec = << 'END'; Type "setprec j" to retain "j" decimal places in the result. END my $hypot = << 'END'; hypot: returns the hypotenuse associated with the sides of a right triangle SYNOPSIS: # double x, y, z, hypot(); $z = hypot( $x, $y ); DESCRIPTION: Calculates the hypotenuse associated with the sides of a right triangle, according to z = sqrt( x**2 + y**2) END my $unity = << 'END'; unity: Relative error approximations for function arguments near unity. SYNOPSIS: # log1p(x) = log(1+x) $y = log1p( $x ); # expm1(x) = exp(x) - 1 $y = expm1( $x ); # cosm1(x) = cos(x) - 1 $y = cosm1( $x ); END my $cmplx = << 'END'; SYNOPSIS: # typedef struct { # double r; real part # double i; imaginary part # }cmplx; # cmplx *a, *b, *c; $x = cmplx(3, 5); # x = 3 + 5 i $y = cmplx(2, 3); # y = 2 + 3 i $z = $x->cadd( $y ); # z = x + y $z = $x->csub( $y ); # z = x - y $z = $x->cmul( $y ); # z = x * y $z = $x->cdiv( $y ); # z = x / y $z = $y->cneg; # z = -y $z = $y->cmov; # z = y print $z->{r}, \' \', $z->{i}; # prints real and imaginary parts of $z print $z->as_string; # prints $z as Re(z) + i Im(z) DESCRIPTION: Addition: c.r = b.r + a.r c.i = b.i + a.i Subtraction: c.r = b.r - a.r c.i = b.i - a.i Multiplication: c.r = b.r * a.r - b.i * a.i c.i = b.r * a.i + b.i * a.r Division: d = a.r * a.r + a.i * a.i c.r = (b.r * a.r + b.i * a.i)/d c.i = (b.i * a.r - b.r * a.i)/d END my $euclid = << 'END'; Rational arithmetic routines SYNOPSIS: # typedef struct # { # double n; numerator # double d; denominator # }fract; $x = fract(3, 4); # x = 3 / 4 $y = fract(2, 3); # y = 2 / 3 $z = $x->radd( $y ); # z = x + y $z = $x->rsub( $y ); # z = x - y $z = $x->rmul( $y ); # z = x * y $z = $x->rdiv( $y ); # z = x / y print $z->{n}, ' ', $z->{d}; # prints numerator and denominator of $z print $z->as_string; # prints the fraction $z print $z->as_mixed_string; # converts $z to a mixed fraction, then prints it $m = 60; $n = 144; ($gcd, $m_reduced, $n_reduced) = euclid($m, $n); # returns the greatest common divisor of $m and $n, as well as # the result of reducing $m and $n by $gcd Arguments of the routines are pointers to the structures. The double precision numbers are assumed, without checking, to be integer valued. Overflow conditions are reported. END %topics = ( 'help' => $help, 'setprec' => $setprec, 'cmplx' => $cmplx, 'cadd' => $cmplx, 'cdiv' => $cmplx, 'cmul' => $cmplx, 'csub' => $cmplx, 'cneg' => $cmplx, 'cmov' => $cmplx, 'radd' => $euclid, 'rmul' => $euclid, 'rdiv' => $euclid, 'rsub' => $euclid, 'fract' => $euclid, 'euclid' => $euclid, 'unity' => $unity, 'cosm1' => $unity, 'log1p' => $unity, 'expm1' => $unity, 'hypot' => $hypot, 'radian' => 'radian: Degrees, minutes, seconds to radians SYNOPSIS: # double d, m, s, radian(); $r = radian( $d, $m, $s ); DESCRIPTION: Converts an angle of degrees, minutes, seconds to radians. ', 'igamc' => 'igamc: Complemented incomplete gamma integral SYNOPSIS: # double a, x, y, igamc(); $y = igamc( $a, $x ); DESCRIPTION: The function is defined by igamc(a,x) = 1 - igam(a,x) inf. - 1 | | -t a-1 = ----- | e t dt. - | | | (a) - x In this implementation both arguments must be positive. The integral is evaluated by either a power series or continued fraction expansion, depending on the relative values of a and x. ', 'lgam' => 'lgam: Natural logarithm of gamma function SYNOPSIS: # double x, y, lgam(); # extern int sgngam; $y = lgam( $x ); DESCRIPTION: Returns the base e (2.718...) logarithm of the absolute value of the gamma function of the argument. The sign (+1 or -1) of the gamma function is returned in a global (extern) variable named sgngam. For arguments greater than 13, the logarithm of the gamma function is approximated by the logarithmic version of Stirling\'s formula using a polynomial approximation of degree 4. Arguments between -33 and +33 are reduced by recurrence to the interval [2,3] of a rational approximation. The cosecant reflection formula is employed for arguments less than -33. Arguments greater than MAXLGM return MAXNUM and an error message. MAXLGM = 2.035093e36 for DEC arithmetic or 2.556348e305 for IEEE arithmetic. ', 'nbdtri' => 'nbdtri: Functional inverse of negative binomial distribution SYNOPSIS: # int k, n; # double p, y, nbdtri(); $p = nbdtri( $k, $n, $y ); DESCRIPTION: Finds the argument p such that nbdtr(k,n,p) is equal to y. ', 'yn' => 'yn: Bessel function of second kind of integer order SYNOPSIS: # double x, y, yn(); # int n; $y = yn( $n, $x ); DESCRIPTION: Returns Bessel function of order n, where n is a (possibly negative) integer. The function is evaluated by forward recurrence on n, starting with values computed by the routines y0() and y1(). If n = 0 or 1 the routine for y0 or y1 is called directly. ', 'igami' => 'igami: Inverse of complemented imcomplete gamma integral SYNOPSIS: # double a, x, p, igami(); $x = igami( $a, $p ); DESCRIPTION: Given p, the function finds x such that igamc( a, x ) = p. Starting with the approximate value 3 x = a t where t = 1 - d - ndtri(p) sqrt(d) and d = 1/9a, the routine performs up to 10 Newton iterations to find the root of igamc(a,x) - p = 0. ', 'catan' => 'catan: Complex circular arc tangent SYNOPSIS: # void catan(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->catan; print $w->{r}, \' \', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: If z = x + iy, then 1 ( 2x ) Re w = - arctan(-----------) + k PI 2 ( 2 2) (1 - x - y ) ( 2 2) 1 (x + (y+1) ) Im w = - log(------------) 4 ( 2 2) (x + (y-1) ) Where k is an arbitrary integer. ', 'atanh' => 'atanh: Inverse hyperbolic tangent SYNOPSIS: # double x, y, atanh(); $y = atanh( $x ); DESCRIPTION: Returns inverse hyperbolic tangent of argument in the range MINLOG to MAXLOG. If |x| < 0.5, the rational form x + x**3 P(x)/Q(x) is employed. Otherwise, atanh(x) = 0.5 * log( (1+x)/(1-x) ). ', 'yv' => 'yv: Bessel function Yv with noninteger v SYNOPSIS: # double v, x; # double yv( v, x ); $y = yv( $v, $x ); ', 'cexp' => 'cexp: Complex exponential function SYNOPSIS: # void cexp(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->cexp; print $w->{r}, \' \', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: Returns the exponential of the complex argument z into the complex result w. If z = x + iy, r = exp(x), then w = r cos y + i r sin y. ', 'ellpe' => 'ellpe: Complete elliptic integral of the second kind SYNOPSIS: # double m1, y, ellpe(); $y = ellpe( $m1 ); DESCRIPTION: Approximates the integral pi/2 - | | 2 E(m) = | sqrt( 1 - m sin t ) dt | | - 0 Where m = 1 - m1, using the approximation P(x) - x log x Q(x). Though there are no singularities, the argument m1 is used rather than m for compatibility with ellpk(). E(1) = 1; E(0) = pi/2. ', 'chdtr' => 'chdtr: Chi-square distribution SYNOPSIS: # double v, x, y, chdtr(); $y = chdtr( $v, $x ); DESCRIPTION: Returns the area under the left hand tail (from 0 to x) of the Chi square probability density function with v degrees of freedom. inf. - 1 | | v/2-1 -t/2 P( x | v ) = ----------- | t e dt v/2 - | | 2 | (v/2) - x where x is the Chi-square variable. The incomplete gamma integral is used, according to the formula y = chdtr( v, x ) = igam( v/2.0, x/2.0 ). The arguments must both be positive. ', 'zetac' => 'zetac: Riemann zeta function SYNOPSIS: # double x, y, zetac(); $y = zetac( $x ); DESCRIPTION: inf. - -x zetac(x) = > k , x > 1, - k=2 is related to the Riemann zeta function by Riemann zeta(x) = zetac(x) + 1. Extension of the function definition for x < 1 is implemented. Zero is returned for x > log2(MAXNUM). An overflow error may occur for large negative x, due to the gamma function in the reflection formula. ', 'ellpj' => 'ellpj: Jacobian Elliptic Functions SYNOPSIS: # double u, m, sn, cn, dn, phi; # int ellpj(); ($flag, $sn, $cn, $dn, $phi) = ellpj( $u, $m ); DESCRIPTION: Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m), and dn(u|m) of parameter m between 0 and 1, and real argument u. These functions are periodic, with quarter-period on the real axis equal to the complete elliptic integral ellpk(1.0-m). Relation to incomplete elliptic integral: If u = ellik(phi,m), then sn(u|m) = sin(phi), and cn(u|m) = cos(phi). Phi is called the amplitude of u. Computation is by means of the arithmetic-geometric mean algorithm, except when m is within 1e-9 of 0 or 1. In the latter case with m close to 1, the approximation applies only for phi < pi/2. ', 'jn' => 'jn: Bessel function of integer order SYNOPSIS: # int n; # double x, y, jn(); $y = jn( $n, $x ); DESCRIPTION: Returns Bessel function of order n, where n is a (possibly negative) integer. The ratio of jn(x) to j0(x) is computed by backward recurrence. First the ratio jn/jn-1 is found by a continued fraction expansion. Then the recurrence relating successive orders is applied until j0 or j1 is reached. If n = 0 or 1 the routine for j0 or j1 is called directly. ', 'ellpk' => 'ellpk: Complete elliptic integral of the first kind SYNOPSIS: # double m1, y, ellpk(); $y = ellpk( $m1 ); DESCRIPTION: Approximates the integral pi/2 - | | | dt K(m) = | ------------------ | 2 | | sqrt( 1 - m sin t ) - 0 where m = 1 - m1, using the approximation P(x) - log x Q(x). The argument m1 is used rather than m so that the logarithmic singularity at m = 1 will be shifted to the origin; this preserves maximum accuracy. K(0) = pi/2. ', 'chdtrc' => 'chdtrc: Complemented Chi-square distribution SYNOPSIS: # double v, x, y, chdtrc(); $y = chdtrc( $v, $x ); DESCRIPTION: Returns the area under the right hand tail (from x to infinity) of the Chi square probability density function with v degrees of freedom: inf. - 1 | | v/2-1 -t/2 P( x | v ) = ----------- | t e dt v/2 - | | 2 | (v/2) - x where x is the Chi-square variable. The incomplete gamma integral is used, according to the formula y = chdtrc( v, x ) = igamc( v/2.0, x/2.0 ). The arguments must both be positive. ', 'beta' => 'beta: Beta function SYNOPSIS: # double a, b, y, beta(); $y = beta( $a, $b ); DESCRIPTION: - - | (a) | (b) beta( a, b ) = -----------. - | (a+b) For large arguments the logarithm of the function is evaluated using lgam(), then exponentiated. ', 'ceil' => 'ceil: ceil ceil() returns the smallest integer greater than or equal to x. It truncates toward plus infinity. SYNOPSIS: # double x, y, ceil(); $y = ceil( $x ); ', 'spence' => 'spence: Dilogarithm SYNOPSIS: # double x, y, spence(); $y = spence( $x ); DESCRIPTION: Computes the integral x - | | log t spence(x) = - | ----- dt | | t - 1 - 1 for x >= 0. A rational approximation gives the integral in the interval (0.5, 1.5). Transformation formulas for 1/x and 1-x are employed outside the basic expansion range. ', 'chdtri' => 'chdtri: Inverse of complemented Chi-square distribution SYNOPSIS: # double df, x, y, chdtri(); $x = chdtri( $df, $y ); DESCRIPTION: Finds the Chi-square argument x such that the integral from x to infinity of the Chi-square density is equal to the given cumulative probability y. This is accomplished using the inverse gamma integral function and the relation x/2 = igami( df/2, y ); ', 'jv' => 'jv: Bessel function of noninteger order SYNOPSIS: # double v, x, y, jv(); $y = jv( $v, $x ); DESCRIPTION: Returns Bessel function of order v of the argument, where v is real. Negative x is allowed if v is an integer. Several expansions are included: the ascending power series, the Hankel expansion, and two transitional expansions for large v. If v is not too large, it is reduced by recurrence to a region of best accuracy. The transitional expansions give 12D accuracy for v > 500. ', 'btdtr' => 'btdtr: Beta distribution SYNOPSIS: # double a, b, x, y, btdtr(); $y = btdtr( $a, $b, $x ); DESCRIPTION: Returns the area from zero to x under the beta density function: x - - | (a+b) | | a-1 b-1 P(x) = ---------- | t (1-t) dt - - | | | (a) | (b) - 0 This function is identical to the incomplete beta integral function incbet(a, b, x). The complemented function is 1 - P(1-x) = incbet( b, a, x ); ', 'log' => 'log: Natural logarithm SYNOPSIS: # double x, y, log(); $y = log( $x ); DESCRIPTION: Returns the base e (2.718...) logarithm of x. The argument is separated into its exponent and fractional parts. If the exponent is between -1 and +1, the logarithm of the fraction is approximated by log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). Otherwise, setting z = 2(x-1)/x+1), log(x) = z + z**3 P(z)/Q(z). ', 'log10' => 'log10: Common logarithm SYNOPSIS: # double x, y, log10(); $y = log10( $x ); DESCRIPTION: Returns logarithm to the base 10 of x. The argument is separated into its exponent and fractional parts. The logarithm of the fraction is approximated by log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). ', 'atan' => 'atan: Inverse circular tangent (arctangent) SYNOPSIS: # double x, y, atan(); $y = atan( $x ); DESCRIPTION: Returns radian angle between -pi/2 and +pi/2 whose tangent is x. Range reduction is from three intervals into the interval from zero to 0.66. The approximant uses a rational function of degree 4/5 of the form x + x**3 P(x)/Q(x). ', 'frexp' => 'frexp: frexp frexp() extracts the exponent from x. It returns an integer power of two to expnt and the significand between 0.5 and 1 to y. Thus x = y * 2**expn. SYNOPSIS: # double x, y, frexp(); # int expnt; ($y, $expnt) = frexp( $x ); ', 'sin' => 'sin: Circular sine SYNOPSIS: # double x, y, sin(); $y = sin( $x ); DESCRIPTION: Range reduction is into intervals of pi/4. The reduction error is nearly eliminated by contriving an extended precision modular arithmetic. Two polynomial approximating functions are employed. Between 0 and pi/4 the sine is approximated by x + x**3 P(x**2). Between pi/4 and pi/2 the cosine is represented as 1 - x**2 Q(x**2). ', 'tanh' => 'tanh: Hyperbolic tangent SYNOPSIS: # double x, y, tanh(); $y = tanh( $x ); DESCRIPTION: Returns hyperbolic tangent of argument in the range MINLOG to MAXLOG. A rational function is used for |x| < 0.625. The form x + x**3 P(x)/Q(x) of Cody _& Waite is employed. Otherwise, tanh(x) = sinh(x)/cosh(x) = 1 - 2/(exp(2x) + 1). ', 'ellie' => 'ellie: Incomplete elliptic integral of the second kind SYNOPSIS: # double phi, m, y, ellie(); $y = ellie( $phi, $m ); DESCRIPTION: Approximates the integral phi - | | | 2 E(phi_\\m) = | sqrt( 1 - m sin t ) dt | | | - 0 of amplitude phi and modulus m, using the arithmetic - geometric mean algorithm. ', 'ellik' => 'ellik: Incomplete elliptic integral of the first kind SYNOPSIS: # double phi, m, y, ellik(); $y = ellik( $phi, $m ); DESCRIPTION: Approximates the integral phi - | | | dt F(phi_\\m) = | ------------------ | 2 | | sqrt( 1 - m sin t ) - 0 of amplitude phi and modulus m, using the arithmetic - geometric mean algorithm. ', 'mtherr' => 'mtherr: Library common error handling routine SYNOPSIS: char *fctnam; # int code; # int mtherr(); mtherr( $fctnam, $code ); DESCRIPTION: This routine may be called to report one of the following error conditions (in the include file mconf.h). Mnemonic Value Significance DOMAIN 1 argument domain error SING 2 function singularity OVERFLOW 3 overflow range error UNDERFLOW 4 underflow range error TLOSS 5 total loss of precision PLOSS 6 partial loss of precision EDOM 33 Unix domain error code ERANGE 34 Unix range error code The default version of the file prints the function name, passed to it by the pointer fctnam, followed by the error condition. The display is directed to the standard output device. The routine then returns to the calling program. Users may wish to modify the program to abort by calling exit() under severe error conditions such as domain errors. Since all error conditions pass control to this function, the display may be easily changed, eliminated, or directed to an error logging device. SEE ALSO: mconf.h ', 'zeta' => 'zeta: Riemann zeta function of two arguments SYNOPSIS: # double x, q, y, zeta(); $y = zeta( $x, $q ); DESCRIPTION: inf. - -x zeta(x,q) = > (k+q) - k=0 where x > 1 and q is not a negative integer or zero. The Euler-Maclaurin summation formula is used to obtain the expansion n - -x zeta(x,q) = > (k+q) - k=1 1-x inf. B x(x+1)...(x+2j) (n+q) 1 - 2j + --------- - ------- + > -------------------- x-1 x - x+2j+1 2(n+q) j=1 (2j)! (n+q) where the B2j are Bernoulli numbers. Note that (see zetac.c) zeta(x,1) = zetac(x) + 1. ', 'pow' => 'pow: Power function SYNOPSIS: # double x, y, z, pow(); $z = pow( $x, $y ); DESCRIPTION: Computes x raised to the yth power. Analytically, x**y = exp( y log(x) ). Following Cody and Waite, this program uses a lookup table of 2**-i/16 and pseudo extended precision arithmetic to obtain an extra three bits of accuracy in both the logarithm and the exponential. ', 'kn' => 'kn: Modified Bessel function, third kind, integer order SYNOPSIS: # double x, y, kn(); # int n; $y = kn( $n, $x ); DESCRIPTION: Returns modified Bessel function of the third kind of order n of the argument. The range is partitioned into the two intervals [0,9.55] and (9.55, infinity). An ascending power series is used in the low range, and an asymptotic expansion in the high range. ', 'cabs' => 'cabs: Complex absolute value SYNOPSIS: # double r, cabs(); # cmplx z; $z = cmplx(2, 3); # z = 2 + 3 i $r = $z->cabs; DESCRIPTION: If z = x + iy then r = sqrt( x**2 + y**2 ). Overflow and underflow are avoided by testing the magnitudes of x and y before squaring. If either is outside half of the floating point full scale range, both are rescaled. ', 'stdtri' => 'stdtri: Functional inverse of Student\'s t distribution SYNOPSIS: # double p, t, stdtri(); # int k; $t = stdtri( $k, $p ); DESCRIPTION: Given probability p, finds the argument t such that stdtr(k,t) is equal to p. ', 'pdtr' => 'pdtr: Poisson distribution SYNOPSIS: # int k; # double m, y, pdtr(); $y = pdtr( $k, $m ); DESCRIPTION: Returns the sum of the first k terms of the Poisson distribution: k j -- -m m > e -- -- j! j=0 The terms are not summed directly; instead the incomplete gamma integral is employed, according to the relation y = pdtr( k, m ) = igamc( k+1, m ). The arguments must both be positive. ', 'i0e' => 'i0e: Modified Bessel function of order zero, exponentially scaled SYNOPSIS: # double x, y, i0e(); $y = i0e( $x ); DESCRIPTION: Returns exponentially scaled modified Bessel function of order zero of the argument. The function is defined as i0e(x) = exp(-|x|) j0( ix ). ', 'floor' => 'floor: floor floor() returns the largest integer less than or equal to x. It truncates toward minus infinity. SYNOPSIS: # double x, y, floor(); $y = floor( $x ); ', 'struve' => 'struve: Struve function SYNOPSIS: # double v, x, y, struve(); $y = struve( $v, $x ); DESCRIPTION: Computes the Struve function Hv(x) of order v, argument x. Negative x is rejected unless v is an integer. ', 'plancki' => 'plancki: Integral of Planck black body radiation formula SYNOPSIS: # double lambda, T, y, plancki() $y = plancki( $lambda, $T ); DESCRIPTION: Evaluates the definite integral, from wavelength 0 to lambda, of the Planck radiation formula -5 c1 lambda E = ------------------ c2/(lambda T) e - 1 Physical constants c1 = 3.7417749e-16 and c2 = 0.01438769 are built in to the function program. They are scaled to provide a result in watts per square meter. Argument T represents temperature in degrees Kelvin; lambda is wavelength in meters. ', 'polylog' => 'polylog: polylogarithm function SYNOPSIS: # double x, y, polylog(); # int n; $y = polylog( $n, $x ); The polylogarithm of order n is defined by the series inf k - x Li (x) = > --- . n - n k=1 k For x = 1, inf - 1 Li (1) = > --- = Riemann zeta function (n) . n - n k=1 k When n = 2, the function is the dilogarithm, related to the Spence integral: x 1-x - - | | -ln(1-t) | | ln t Li (x) = | -------- dt = | ------ dt = spence(1-x) . 2 | | t | | 1 - t - - 0 1 ', 'bernum' => 'bernum: Bernoulli numbers SYNOPSIS: ($num, $den) = bernum( $n); ($num_array, $den_array) = bernum(); DESCRIPTION: This calculates the Bernoulli numbers, up to 30th order. If called with an integer argument, the numerator and denominator of that Bernoulli number is returned; if called with no argument, two array references representing the numerator and denominators of the first 30 Bernoulli numbers are returned. ', 'csqrt' => 'csqrt: Complex square root SYNOPSIS: # void csqrt(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->csqrt; print $w->{r}, \' \', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: If z = x + iy, r = |z|, then 1/2 Im w = [ (r - x)/2 ] , Re w = y / 2 Im w. Note that -w is also a square root of z. The root chosen is always in the upper half plane. Because of the potential for cancellation error in r - x, the result is sharpened by doing a Heron iteration (see sqrt.c) in complex arithmetic. ', 'exp10' => 'exp10: Base 10 exponential function (Common antilogarithm) SYNOPSIS: # double x, y, exp10(); $y = exp10( $x ); DESCRIPTION: Returns 10 raised to the x power. Range reduction is accomplished by expressing the argument as 10**x = 2**n 10**f, with |f| < 0.5 log10(2). The Pade\' form 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) is used to approximate 10**f. ', 'gdtrc' => 'gdtrc: Complemented gamma distribution function SYNOPSIS: # double a, b, x, y, gdtrc(); $y = gdtrc( $a, $b, $x ); DESCRIPTION: Returns the integral from x to infinity of the gamma probability density function: inf. b - a | | b-1 -at y = ----- | t e dt - | | | (b) - x The incomplete gamma integral is used, according to the relation y = igamc( b, ax ). ', 'incbet' => 'incbet: Incomplete beta integral SYNOPSIS: # double a, b, x, y, incbet(); $y = incbet( $a, $b, $x ); DESCRIPTION: Returns incomplete beta integral of the arguments, evaluated from zero to x. The function is defined as x - - | (a+b) | | a-1 b-1 ----------- | t (1-t) dt. - - | | | (a) | (b) - 0 The domain of definition is 0 <= x <= 1. In this implementation a and b are restricted to positive values. The integral from x to 1 may be obtained by the symmetry relation 1 - incbet( a, b, x ) = incbet( b, a, 1-x ). The integral is evaluated by a continued fraction expansion or, when b*x is small, by a power series. ', 'nbdtr' => 'nbdtr: Negative binomial distribution SYNOPSIS: # int k, n; # double p, y, nbdtr(); $y = nbdtr( $k, $n, $p ); DESCRIPTION: Returns the sum of the terms 0 through k of the negative binomial distribution: k -- ( n+j-1 ) n j > ( ) p (1-p) -- ( j ) j=0 In a sequence of Bernoulli trials, this is the probability that k or fewer failures precede the nth success. The terms are not computed individually; instead the incomplete beta integral is employed, according to the formula y = nbdtr( k, n, p ) = incbet( n, k+1, p ). The arguments must be positive, with p ranging from 0 to 1. ', 'fabs' => 'fabs: Absolute value SYNOPSIS: # double x, y; $y = fabs( $x ); DESCRIPTION: Returns the absolute value of the argument. ', 'powi' => 'powi: Real raised to integer power SYNOPSIS: # double x, y, powi(); # int n; $y = powi( $x, $n ); DESCRIPTION: Returns argument x raised to the nth power. The routine efficiently decomposes n as a sum of powers of two. The desired power is a product of two-to-the-kth powers of x. Thus to compute the 32767 power of x requires 28 multiplications instead of 32767 multiplications. ', 'i1e' => 'i1e: Modified Bessel function of order one, exponentially scaled SYNOPSIS: # double x, y, i1e(); $y = i1e( $x ); DESCRIPTION: Returns exponentially scaled modified Bessel function of order one of the argument. The function is defined as i1(x) = -i exp(-|x|) j1( ix ). ', 'exp2' => 'exp2: Base 2 exponential function SYNOPSIS: # double x, y, exp2(); $y = exp2( $x ); DESCRIPTION: Returns 2 raised to the x power. Range reduction is accomplished by separating the argument into an integer k and fraction f such that x k f 2 = 2 2. A Pade\' form 1 + 2x P(x**2) / (Q(x**2) - x P(x**2) ) approximates 2**x in the basic range [-0.5, 0.5]. ', 'expxx' => 'expxx: exp(x*x) # double x, y, expxx(); # int sign; $y = expxx( $x ); DESCRIPTION: Computes y = exp(x*x) while suppressing error amplification that would ordinarily arise from the inexactness of the exponential argument x*x. If sign < 0, exp(-x*x) is returned. If sign > 0, or omitted, exp(x*x) is returned. ', 'tan' => 'tan: Circular tangent SYNOPSIS: # double x, y, tan(); $y = tan( $x ); DESCRIPTION: Returns the circular tangent of the radian argument x. Range reduction is modulo pi/4. A rational function x + x**3 P(x**2)/Q(x**2) is employed in the basic interval [0, pi/4]. ', 'sici' => 'sici: Sine and cosine integrals SYNOPSIS: # double x, Ci, Si, sici(); ($flag, $Si, $Ci) = sici( $x ); DESCRIPTION: Evaluates the integrals x - | cos t - 1 Ci(x) = eul + ln x + | --------- dt, | t - 0 x - | sin t Si(x) = | ----- dt | t - 0 where eul = 0.57721566490153286061 is Euler\'s constant. The integrals are approximated by rational functions. For x > 8 auxiliary functions f(x) and g(x) are employed such that Ci(x) = f(x) sin(x) - g(x) cos(x) Si(x) = pi/2 - f(x) cos(x) - g(x) sin(x) ', 'ccos' => 'ccos: Complex circular cosine SYNOPSIS: # void ccos(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->ccos; print $w->{r}, \' \', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: If z = x + iy, then w = cos x cosh y - i sin x sinh y. ', 'ccot' => 'ccot: Complex circular cotangent SYNOPSIS: # void ccot(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->ccot; print $w->{r}, \' \', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: If z = x + iy, then sin 2x - i sinh 2y w = --------------------. cosh 2y - cos 2x On the real axis, the denominator has zeros at even multiples of PI/2. Near these points it is evaluated by a Taylor series. ', 'sqrt' => 'sqrt: Square root SYNOPSIS: # double x, y, sqrt(); $y = sqrt( $x ); DESCRIPTION: Returns the square root of x. Range reduction involves isolating the power of two of the argument and using a polynomial approximation to obtain a rough value for the square root. Then Heron\'s iteration is used three times to converge to an accurate value. ', 'tandg' => 'tandg: Circular tangent of argument in degrees SYNOPSIS: # double x, y, tandg(); $y = tandg( $x ); DESCRIPTION: Returns the circular tangent of the argument x in degrees. Range reduction is modulo pi/4. A rational function x + x**3 P(x**2)/Q(x**2) is employed in the basic interval [0, pi/4]. ', 'cosdg' => 'cosdg: Circular cosine of angle in degrees SYNOPSIS: # double x, y, cosdg(); $y = cosdg( $x ); DESCRIPTION: Range reduction is into intervals of 45 degrees. Two polynomial approximating functions are employed. Between 0 and pi/4 the cosine is approximated by 1 - x**2 P(x**2). Between pi/4 and pi/2 the sine is represented as x + x**3 P(x**2). ', 'fdtr' => 'fdtr: F distribution SYNOPSIS: # int df1, df2; # double x, y, fdtr(); $y = fdtr( $df1, $df2, $x ); DESCRIPTION: Returns the area from zero to x under the F density function (also known as Snedcor\'s density or the variance ratio density). This is the density of x = (u1/df1)/(u2/df2), where u1 and u2 are random variables having Chi square distributions with df1 and df2 degrees of freedom, respectively. The incomplete beta integral is used, according to the formula P(x) = incbet( df1/2, df2/2, df1*x/(df2 + df1*x) ). The arguments a and b are greater than zero, and x is nonnegative. ', 'rgamma' => 'rgamma: Reciprocal gamma function SYNOPSIS: # double x, y, rgamma(); $y = rgamma( $x ); DESCRIPTION: Returns one divided by the gamma function of the argument. The function is approximated by a Chebyshev expansion in the interval [0,1]. Range reduction is by recurrence for arguments between -34.034 and +34.84425627277176174. 1/MAXNUM is returned for positive arguments outside this range. For arguments less than -34.034 the cosecant reflection formula is applied; lograrithms are employed to avoid unnecessary overflow. The reciprocal gamma function has no singularities, but overflow and underflow may occur for large arguments. These conditions return either MAXNUM or 1/MAXNUM with appropriate sign. ', 'shichi' => 'shichi: Hyperbolic sine and cosine integrals SYNOPSIS: # double x, Chi, Shi, shichi(); ($flag, $Shi, $Chi) = shichi( $x ); DESCRIPTION: Approximates the integrals x - | | cosh t - 1 Chi(x) = eul + ln x + | ----------- dt, | | t - 0 x - | | sinh t Shi(x) = | ------ dt | | t - 0 where eul = 0.57721566490153286061 is Euler\'s constant. The integrals are evaluated by power series for x < 8 and by Chebyshev expansions for x between 8 and 88. For large x, both functions approach exp(x)/2x. Arguments greater than 88 in magnitude return MAXNUM. ', 'ndtr' => 'ndtr: Normal distribution function SYNOPSIS: # double x, y, ndtr(); $y = ndtr( $x ); DESCRIPTION: Returns the area under the Gaussian probability density function, integrated from minus infinity to x: x - 1 | | 2 ndtr(x) = --------- | exp( - t /2 ) dt sqrt(2pi) | | - -inf. = ( 1 + erf(z) ) / 2 where z = x/sqrt(2). Computation is via the functions erf and erfc. ', 'lbeta' => 'lbeta: Natural logarithm of |beta| SYNOPSIS: # double a, b; # double lbeta( a, b ); $y = lbeta( $a, $b); ', 'cacos' => 'cacos: Complex circular arc cosine SYNOPSIS: # void cacos(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->cacos; print $w->{r}, \' \', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: w = arccos z = PI/2 - arcsin z. ', 'cbrt' => 'cbrt: Cube root SYNOPSIS: # double x, y, cbrt(); $y = cbrt( $x ); DESCRIPTION: Returns the cube root of the argument, which may be negative. Range reduction involves determining the power of 2 of the argument. A polynomial of degree 2 applied to the mantissa, and multiplication by the cube root of 1, 2, or 4 approximates the root to within about 0.1%. Then Newton\'s iteration is used three times to converge to an accurate result. ', 'exp' => 'exp: Exponential function SYNOPSIS: # double x, y, exp(); $y = exp( $x ); DESCRIPTION: Returns e (2.71828...) raised to the x power. Range reduction is accomplished by separating the argument into an integer k and fraction f such that x k f e = 2 e. A Pade\' form 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) of degree 2/3 is used to approximate exp(f) in the basic interval [-0.5, 0.5]. ', 'threef0' => 'threef0: Hypergeometric function 3F0 SYNOPSIS: # double a, b, c, x, value; # double *err; ($value, $err) = threef0( $a, $b, $c, $x ) ', 'hyperg' => 'hyperg: Confluent hypergeometric function SYNOPSIS: # double a, b, x, y, hyperg(); $y = hyperg( $a, $b, $x ); DESCRIPTION: Computes the confluent hypergeometric function 1 2 a x a(a+1) x F ( a,b;x ) = 1 + ---- + --------- + ... 1 1 b 1! b(b+1) 2! Many higher transcendental functions are special cases of this power series. As is evident from the formula, b must not be a negative integer or zero unless a is an integer with 0 >= a > b. The routine attempts both a direct summation of the series and an asymptotic expansion. In each case error due to roundoff, cancellation, and nonconvergence is estimated. The result with smaller estimated error is returned. ', 'log2' => 'log2: Base 2 logarithm SYNOPSIS: # double x, y, log2(); $y = log2( $x ); DESCRIPTION: Returns the base 2 logarithm of x. The argument is separated into its exponent and fractional parts. If the exponent is between -1 and +1, the base e logarithm of the fraction is approximated by log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). Otherwise, setting z = 2(x-1)/x+1), log(x) = z + z**3 P(z)/Q(z). ', 'airy' => 'airy: Airy function SYNOPSIS: # double x, ai, aiprime, bi, biprime; # int airy(); ($flag, $ai, $aiprime, $bi, $biprime) = airy( $x ); DESCRIPTION: Solution of the differential equation y"(x) = xy. The function returns the two independent solutions Ai, Bi and their first derivatives Ai\'(x), Bi\'(x). Evaluation is by power series summation for small x, by rational minimax approximations for large x. ', 'onef2' => 'onef2: Hypergeometric function 1F2 SYNOPSIS: # double a, b, c, x, value; # double *err; ($value, $err) = onef2( $a, $b, $c, $x) ', 'ei' => 'ei: Exponential integral SYNOPSIS: #double x, y, ei(); $y = ei( $x ); DESCRIPTION: x - t | | e Ei(x) = -|- --- dt . | | t - -inf Not defined for x <= 0. See also expn.c. ', 'expn' => 'expn: Exponential integral En SYNOPSIS: # int n; # double x, y, expn(); $y = expn( $n, $x ); DESCRIPTION: Evaluates the exponential integral inf. - | | -xt | e E (x) = | ---- dt. n | n | | t - 1 Both n and x must be nonnegative. The routine employs either a power series, a continued fraction, or an asymptotic formula depending on the relative values of n and x. ', 'dawsn' => 'dawsn: Dawson\'s Integral SYNOPSIS: # double x, y, dawsn(); $y = dawsn( $x ); DESCRIPTION: Approximates the integral x - 2 | | 2 dawsn(x) = exp( -x ) | exp( t ) dt | | - 0 Three different rational approximations are employed, for the intervals 0 to 3.25; 3.25 to 6.25; and 6.25 up. ', 'clog' => 'clog: Complex natural logarithm SYNOPSIS: # void clog(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->clog; print $w->{r}, \' \', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: Returns complex logarithm to the base e (2.718...) of the complex argument x. If z = x + iy, r = sqrt( x**2 + y**2 ), then w = log(r) + i arctan(y/x). The arctangent ranges from -PI to +PI. ', 'acos' => 'acos: Inverse circular cosine SYNOPSIS: # double x, y, acos(); $y = acos( $x ); DESCRIPTION: Returns radian angle between 0 and pi whose cosine is x. Analytically, acos(x) = pi/2 - asin(x). However if |x| is near 1, there is cancellation error in subtracting asin(x) from pi/2. Hence if x < -0.5, acos(x) = pi - 2.0 * asin( sqrt((1+x)/2) ); or if x > +0.5, acos(x) = 2.0 * asin( sqrt((1-x)/2) ). ', 'fresnl' => 'fresnl: Fresnel integral SYNOPSIS: # double x, S, C; # void fresnl(); ($flag, $S, $C) = fresnl( $x ); DESCRIPTION: Evaluates the Fresnel integrals x - | | C(x) = | cos(pi/2 t**2) dt, | | - 0 x - | | S(x) = | sin(pi/2 t**2) dt. | | - 0 The integrals are evaluated by a power series for x < 1. For x >= 1 auxiliary functions f(x) and g(x) are employed such that C(x) = 0.5 + f(x) sin( pi/2 x**2 ) - g(x) cos( pi/2 x**2 ) S(x) = 0.5 - f(x) cos( pi/2 x**2 ) - g(x) sin( pi/2 x**2 ) ', 'psi' => 'psi: Psi (digamma) function SYNOPSIS: # double x, y, psi(); $y = psi( $x ); DESCRIPTION: d - psi(x) = -- ln | (x) dx is the logarithmic derivative of the gamma function. For integer x, n-1 - psi(n) = -EUL + > 1/k. - k=1 This formula is used for 0 < n <= 10. If x is negative, it is transformed to a positive argument by the reflection formula psi(1-x) = psi(x) + pi cot(pi x). For general positive x, the argument is made greater than 10 using the recurrence psi(x+1) = psi(x) + 1/x. Then the following asymptotic expansion is applied: inf. B - 2k psi(x) = log(x) - 1/2x - > ------- - 2k k=1 2k x where the B2k are Bernoulli numbers. ', 'csinh' => 'csinh: Complex hyperbolic sine SYNOPSIS: # void csinh(); # cmplx z, w; $z = cmplx(2, 3); # z = 2 + 3 i $w = $z->csinh; print $w->{r}, " ", $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: csinh z = (cexp(z) - cexp(-z))/2 = sinh x * cos y + i cosh x * sin y . ', 'casinh' => 'casinh: Complex inverse hyperbolic sine SYNOPSIS: # void casinh(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->casinh; print $w->{r}, " ", $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: casinh z = -i casin iz . ', 'ccosh' => 'ccosh: Complex hyperbolic cosine SYNOPSIS: # void ccosh(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->ccosh; print $w->{r}, " ", $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: ccosh(z) = cosh x cos y + i sinh x sin y . ', 'cacosh' => 'cacosh: Complex inverse hyperbolic cosine SYNOPSIS: # void cacosh(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->cacosh; print $w->{r}, " ", $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: acosh z = i acos z . ', 'ctanh' => 'ctanh: Complex hyperbolic tangent SYNOPSIS: # void ctanh(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->ctanh; print $w->{r}, " ", $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: tanh z = (sinh 2x + i sin 2y) / (cosh 2x + cos 2y) . ', 'catanh' => 'catanh: Complex inverse hyperbolic tangent SYNOPSIS: # void catanh(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->catanh; print $w->{r}, " ", $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: Inverse tanh, equal to -i catan (iz); ', 'cpow' => 'cpow: Complex power function SYNOPSIS: # void cpow(); # cmplx x, z, w; $x = cmplx(5, 6); # x = 5 + 6 i $z = cmplx(2, 3); # z = 2 + 3 i $w = $x->cpow($z); print $w->{r}, " ", $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: Raises complex X to the complex Zth power. Definition is per AMS55 # 4.2.8, analytically equivalent to cpow(x,z) = cexp(z clog(x)). ', 'csin' => 'csin: Complex circular sine SYNOPSIS: # void csin(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->csin; print $w->{r}, \' \', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: If z = x + iy, then w = sin x cosh y + i cos x sinh y. ', 'stdtr' => 'stdtr: Student\'s t distribution SYNOPSIS: # double t, stdtr(); short k; $y = stdtr( $k, $t ); DESCRIPTION: Computes the integral from minus infinity to t of the Student t distribution with integer k > 0 degrees of freedom: t - | | - | 2 -(k+1)/2 | ( (k+1)/2 ) | ( x ) ---------------------- | ( 1 + --- ) dx - | ( k ) sqrt( k pi ) | ( k/2 ) | | | - -inf. Relation to incomplete beta integral: 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) where z = k/(k + t**2). For t < -2, this is the method of computation. For higher t, a direct method is derived from integration by parts. Since the function is symmetric about t=0, the area under the right tail of the density is found by calling the function with -t instead of t. ', 'cotdg' => 'cotdg: Circular cotangent of argument in degrees SYNOPSIS: # double x, y, cotdg(); $y = cotdg( $x ); DESCRIPTION: Returns the circular cotangent of the argument x in degrees. Range reduction is modulo pi/4. A rational function x + x**3 P(x**2)/Q(x**2) is employed in the basic interval [0, pi/4]. ERROR MESSAGES: message condition value returned cotdg total loss x > 8.0e14 (DEC) 0.0 x > 1.0e14 (IEEE) cotdg singularity x = 180 k MAXNUM ', 'asinh' => 'asinh: Inverse hyperbolic sine SYNOPSIS: # double x, y, asinh(); $y = asinh( $x ); DESCRIPTION: Returns inverse hyperbolic sine of argument. If |x| < 0.5, the function is approximated by a rational form x + x**3 P(x)/Q(x). Otherwise, asinh(x) = log( x + sqrt(1 + x*x) ). ', 'i0' => 'i0: Modified Bessel function of order zero SYNOPSIS: # double x, y, i0(); $y = i0( $x ); DESCRIPTION: Returns modified Bessel function of order zero of the argument. The function is defined as i0(x) = j0( ix ). The range is partitioned into the two intervals [0,8] and (8, infinity). Chebyshev polynomial expansions are employed in each interval. ', 'i1' => 'i1: Modified Bessel function of order one SYNOPSIS: # double x, y, i1(); $y = i1( $x ); DESCRIPTION: Returns modified Bessel function of order one of the argument. The function is defined as i1(x) = -i j1( ix ). The range is partitioned into the two intervals [0,8] and (8, infinity). Chebyshev polynomial expansions are employed in each interval. ', 'constants' => 'constants: various useful constants SYNOPSIS $PI : 3.14159265358979323846 # pi $PIO2 : 1.57079632679489661923 # pi/2 $PIO4 : 0.785398163397448309616 # pi/4 $SQRT2 : 1.41421356237309504880 # sqrt(2) $SQRTH : 0.707106781186547524401 # sqrt(2)/2 $LOG2E : 1.4426950408889634073599 # 1/log(2) $SQ2OPI : 0.79788456080286535587989 # sqrt( 2/pi ) $LOGE2 : 0.693147180559945309417 # log(2) $LOGSQ2 : 0.346573590279972654709 # log(2)/2 $THPIO4 : 2.35619449019234492885 # 3*pi/4 $TWOOPI : 0.636619772367581343075535 # 2/pi As well, there are 4 machine-specific numbers available: $MACHEP : machine roundoff error $MAXLOG : maximum log on the machine $MINLOG : minimum log on the machine $MAXNUM : largest number represented ', 'erf' => 'erf: Error function SYNOPSIS: # double x, y, erf(); $y = erf( $x ); DESCRIPTION: The integral is x - 2 | | 2 erf(x) = -------- | exp( - t ) dt. sqrt(pi) | | - 0 The magnitude of x is limited to 9.231948545 for DEC arithmetic; 1 or -1 is returned outside this range. For 0 <= |x| < 1, erf(x) = x * P4(x**2)/Q5(x**2); otherwise erf(x) = 1 - erfc(x). ', 'k0e' => 'k0e: Modified Bessel function, third kind, order zero, exponentially scaled SYNOPSIS: # double x, y, k0e(); $y = k0e( $x ); DESCRIPTION: Returns exponentially scaled modified Bessel function of the third kind of order zero of the argument. k0e(x) = exp(x) * k0(x). ', 'erfc' => 'erfc: Complementary error function SYNOPSIS: # double x, y, erfc(); $y = erfc( $x ); DESCRIPTION: 1 - erf(x) = inf. - 2 | | 2 erfc(x) = -------- | exp( - t ) dt sqrt(pi) | | - x For small x, erfc(x) = 1 - erf(x); otherwise rational approximations are computed. ', 'gamma' => 'gamma: Gamma function SYNOPSIS: # double x, y, gamma(); # extern int sgngam; $y = gamma( $x ); DESCRIPTION: Returns gamma function of the argument. The result is correctly signed, and the sign (+1 or -1) is also returned in a global (extern) variable named sgngam. This variable is also filled in by the logarithmic gamma function lgam(). Arguments |x| <= 34 are reduced by recurrence and the function approximated by a rational function of degree 6/7 in the interval (2,3). Large arguments are handled by Stirling\'s formula. Large negative arguments are made positive using a reflection formula. ', 'incbi' => 'incbi: Inverse of imcomplete beta integral SYNOPSIS: # double a, b, x, y, incbi(); $x = incbi( $a, $b, $y ); DESCRIPTION: Given y, the function finds x such that incbet( a, b, x ) = y . The routine performs interval halving or Newton iterations to find the root of incbet(a,b,x) - y = 0. ', 'round' => 'round: Round double to nearest or even integer valued double SYNOPSIS: # double x, y, round(); $y = round( $x ); DESCRIPTION: Returns the nearest integer to x as a double precision floating point result. If x ends in 0.5 exactly, the nearest even integer is chosen. ', 'drand' => 'drand: Pseudorandom number generator SYNOPSIS: # double y, drand(); ($flag, $y) = drand( ); DESCRIPTION: Yields a random number 1.0 <= y < 2.0. The three-generator congruential algorithm by Brian Wichmann and David Hill (BYTE magazine, March, 1987, pp 127-8) is used. The period, given by them, is 6953607871644. Versions invoked by the different arithmetic compile time options DEC, IBMPC, and MIEEE, produce approximately the same sequences, differing only in the least significant bits of the numbers. The UNK option implements the algorithm as recommended in the BYTE article. It may be used on all computers. However, the low order bits of a double precision number may not be adequately random, and may vary due to arithmetic implementation details on different computers. The other compile options generate an additional random integer that overwrites the low order bits of the double precision number. This reduces the period by a factor of two but tends to overcome the problems mentioned. ', 'y0' => 'y0: Bessel function of the second kind, order zero SYNOPSIS: # double x, y, y0(); $y = y0( $x ); DESCRIPTION: Returns Bessel function of the second kind, of order zero, of the argument. The domain is divided into the intervals [0, 5] and (5, infinity). In the first interval a rational approximation R(x) is employed to compute y0(x) = R(x) + 2 * log(x) * j0(x) / PI. Thus a call to j0() is required. In the second interval, the Hankel asymptotic expansion is employed with two rational functions of degree 6/6 and 7/7. ', 'fac' => 'fac: Factorial function SYNOPSIS: # double y, fac(); # int i; $y = fac( $i ); DESCRIPTION: Returns factorial of i = 1 * 2 * 3 * ... * i. fac(0) = 1.0. Due to machine arithmetic bounds the largest value of i accepted is 33 in DEC arithmetic or 170 in IEEE arithmetic. Greater values, or negative ones, produce an error message and return MAXNUM. ', 'y1' => 'y1: Bessel function of second kind of order one SYNOPSIS: # double x, y, y1(); $y = y1( $x ); DESCRIPTION: Returns Bessel function of the second kind of order one of the argument. The domain is divided into the intervals [0, 8] and (8, infinity). In the first interval a 25 term Chebyshev expansion is used, and a call to j1() is required. In the second, the asymptotic trigonometric representation is employed using two rational functions of degree 5/5. ', 'casin' => 'casin: Complex circular arc sine SYNOPSIS: # void casin(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->casin; print $w->{r}, \' \', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: Inverse complex sine: 2 w = -i clog( iz + csqrt( 1 - z ) ). ', 'acosh' => 'acosh: Inverse hyperbolic cosine SYNOPSIS: # double x, y, acosh(); $y = acosh( $x ); DESCRIPTION: Returns inverse hyperbolic cosine of argument. If 1 <= x < 1.5, a rational approximation sqrt(z) * P(z)/Q(z) where z = x-1, is used. Otherwise, acosh(x) = log( x + sqrt( (x-1)(x+1) ). ', 'bdtrc' => 'bdtrc: Complemented binomial distribution SYNOPSIS: # int k, n; # double p, y, bdtrc(); $y = bdtrc( $k, $n, $p ); DESCRIPTION: Returns the sum of the terms k+1 through n of the Binomial probability density: n -- ( n ) j n-j > ( ) p (1-p) -- ( j ) j=k+1 The terms are not summed directly; instead the incomplete beta integral is employed, according to the formula y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ). The arguments must be positive, with p ranging from 0 to 1. ', 'gdtr' => 'gdtr: Gamma distribution function SYNOPSIS: # double a, b, x, y, gdtr(); $y = gdtr( $a, $b, $x ); DESCRIPTION: Returns the integral from zero to x of the gamma probability density function: x b - a | | b-1 -at y = ----- | t e dt - | | | (b) - 0 The incomplete gamma integral is used, according to the relation y = igam( b, ax ). ', 'lrand' => 'lrand: Pseudorandom number generator SYNOPSIS: long y, lrand(); $y = lrand( ); DESCRIPTION: Yields a long integer random number. The three-generator congruential algorithm by Brian Wichmann and David Hill (BYTE magazine, March, 1987, pp 127-8) is used. The period, given by them, is 6953607871644. ', 'sinh' => 'sinh: Hyperbolic sine SYNOPSIS: # double x, y, sinh(); $y = sinh( $x ); DESCRIPTION: Returns hyperbolic sine of argument in the range MINLOG to MAXLOG. The range is partitioned into two segments. If |x| <= 1, a rational function of the form x + x**3 P(x)/Q(x) is employed. Otherwise the calculation is sinh(x) = ( exp(x) - exp(-x) )/2. ', 'fdtrc' => 'fdtrc: Complemented F distribution SYNOPSIS: # int df1, df2; # double x, y, fdtrc(); $y = fdtrc( $df1, $df2, $x ); DESCRIPTION: Returns the area from x to infinity under the F density function (also known as Snedcor\'s density or the variance ratio density). inf. - 1 | | a-1 b-1 1-P(x) = ------ | t (1-t) dt B(a,b) | | - x The incomplete beta integral is used, according to the formula P(x) = incbet( df2/2, df1/2, df2/(df2 + df1*x) ). ', 'bdtri' => 'bdtri: Inverse binomial distribution SYNOPSIS: # int k, n; # double p, y, bdtri(); $p = bdtri( $k, $n, $y ); DESCRIPTION: Finds the event probability p such that the sum of the terms 0 through k of the Binomial probability density is equal to the given cumulative probability y. This is accomplished using the inverse beta integral function and the relation 1 - p = incbi( n-k, k+1, y ). ', 'atan2' => 'atan2: Quadrant correct inverse circular tangent SYNOPSIS: # double x, y, z, atan2(); $z = atan2( $y, $x ); DESCRIPTION: Returns radian angle whose tangent is y/x. Define compile time symbol ANSIC = 1 for ANSI standard, range -PI < z <= +PI, args (y,x); else ANSIC = 0 for range 0 to 2PI, args (x,y). ', 'lsqrt' => 'lsqrt: Integer square root SYNOPSIS: long x, y; long lsqrt(); $y = lsqrt( $x ); DESCRIPTION: Returns a long integer square root of the long integer argument. The computation is by binary long division. The largest possible result is lsqrt(2,147,483,647) = 46341. If x < 0, the square root of |x| is returned, and an error message is printed. ', 'hyp2f0' => 'hyp2f0: Gauss hypergeometric function F 2 0 SYNOPSIS: # double a, b, x, value, *err; # int type; /* determines what converging factor to use */ ($value, $err) = hyp2f0( $a, $b, $x, $type ) ', 'fdtri' => 'fdtri: Inverse of complemented F distribution SYNOPSIS: # int df1, df2; # double x, p, fdtri(); $x = fdtri( $df1, $df2, $p ); DESCRIPTION: Finds the F density argument x such that the integral from x to infinity of the F density is equal to the given probability p. This is accomplished using the inverse beta integral function and the relations z = incbi( df2/2, df1/2, p ) x = df2 (1-z) / (df1 z). Note: the following relations hold for the inverse of the uncomplemented F distribution: z = incbi( df1/2, df2/2, p ) x = df2 z / (df1 (1-z)). ', 'hyp2f1' => 'hyp2f1: Gauss hypergeometric function F 2 1 SYNOPSIS: # double a, b, c, x, y, hyp2f1(); $y = hyp2f1( $a, $b, $c, $x ); DESCRIPTION: hyp2f1( a, b, c, x ) = F ( a, b; c; x ) 2 1 inf. - a(a+1)...(a+k) b(b+1)...(b+k) k+1 = 1 + > ----------------------------- x . - c(c+1)...(c+k) (k+1)! k = 0 Cases addressed are Tests and escapes for negative integer a, b, or c Linear transformation if c - a or c - b negative integer Special case c = a or c = b Linear transformation for x near +1 Transformation for x < -0.5 Psi function expansion if x > 0.5 and c - a - b integer Conditionally, a recurrence on c to make c-a-b > 0 |x| > 1 is rejected. The parameters a, b, c are considered to be integer valued if they are within 1.0e-14 of the nearest integer (1.0e-13 for IEEE arithmetic). ', 'j0' => 'j0: Bessel function of order zero SYNOPSIS: # double x, y, j0(); $y = j0( $x ); DESCRIPTION: Returns Bessel function of order zero of the argument. The domain is divided into the intervals [0, 5] and (5, infinity). In the first interval the following rational approximation is used: 2 2 (w - r ) (w - r ) P (w) / Q (w) 1 2 3 8 2 where w = x and the two r\'s are zeros of the function. In the second interval, the Hankel asymptotic expansion is employed with two rational functions of degree 6/6 and 7/7. ', 'j1' => 'j1: Bessel function of order one SYNOPSIS: # double x, y, j1(); $y = j1( $x ); DESCRIPTION: Returns Bessel function of order one of the argument. The domain is divided into the intervals [0, 8] and (8, infinity). In the first interval a 24 term Chebyshev expansion is used. In the second, the asymptotic trigonometric representation is employed using two rational functions of degree 5/5. ', 'ldexp' => 'ldexp: multiplies x by 2**n. SYNOPSIS: # double x, y, ldexp(); # int n; $y = ldexp( $x, $n ); ', 'pdtrc' => 'pdtrc: Complemented poisson distribution SYNOPSIS: # int k; # double m, y, pdtrc(); $y = pdtrc( $k, $m ); DESCRIPTION: Returns the sum of the terms k+1 to infinity of the Poisson distribution: inf. j -- -m m > e -- -- j! j=k+1 The terms are not summed directly; instead the incomplete gamma integral is employed, according to the formula y = pdtrc( k, m ) = igam( k+1, m ). The arguments must both be positive. ', 'igam' => 'igam: Incomplete gamma integral SYNOPSIS: # double a, x, y, igam(); $y = igam( $a, $x ); DESCRIPTION: The function is defined by x - 1 | | -t a-1 igam(a,x) = ----- | e t dt. - | | | (a) - 0 In this implementation both arguments must be positive. The integral is evaluated by either a power series or continued fraction expansion, depending on the relative values of a and x. ', 'machconst' => 'machconst: Globally declared constants SYNOPSIS: extern double nameofconstant; DESCRIPTION: This file contains a number of mathematical constants and also some needed size parameters of the computer arithmetic. The values are supplied as arrays of hexadecimal integers for IEEE arithmetic; arrays of octal constants for DEC arithmetic; and in a normal decimal scientific notation for other machines. The particular notation used is determined by a symbol (DEC, IBMPC, or UNK) defined in the include file mconf.h. The default size parameters are as follows. For DEC and UNK modes: MACHEP = 1.38777878078144567553E-17 2**-56 MAXLOG = 8.8029691931113054295988E1 log(2**127) MINLOG = -8.872283911167299960540E1 log(2**-128) MAXNUM = 1.701411834604692317316873e38 2**127 For IEEE arithmetic (IBMPC): MACHEP = 1.11022302462515654042E-16 2**-53 MAXLOG = 7.09782712893383996843E2 log(2**1024) MINLOG = -7.08396418532264106224E2 log(2**-1022) MAXNUM = 1.7976931348623158E308 2**1024 These lists are subject to change. ', 'k1e' => 'k1e: Modified Bessel function, third kind, order one, exponentially scaled SYNOPSIS: # double x, y, k1e(); $y = k1e( $x ); DESCRIPTION: Returns exponentially scaled modified Bessel function of the third kind of order one of the argument: k1e(x) = exp(x) * k1(x). ', 'ndtri' => 'ndtri: Inverse of Normal distribution function SYNOPSIS: # double x, y, ndtri(); $x = ndtri( $y ); DESCRIPTION: Returns the argument, x, for which the area under the Gaussian probability density function (integrated from minus infinity to x) is equal to y. For small arguments 0 < y < exp(-2), the program computes z = sqrt( -2.0 * log(y) ); then the approximation is x = z - log(z)/z - (1/z) P(1/z) / Q(1/z). There are two rational functions P/Q, one for 0 < y < exp(-32) and the other for y up to exp(-2). For larger arguments, w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). ', 'pdtri' => 'pdtri: Inverse Poisson distribution SYNOPSIS: # int k; # double m, y, pdtr(); $m = pdtri( $k, $y ); DESCRIPTION: Finds the Poisson variable x such that the integral from 0 to x of the Poisson density is equal to the given probability y. This is accomplished using the inverse gamma integral function and the relation m = igami( k+1, y ). ', 'cos' => 'cos: Circular cosine SYNOPSIS: # double x, y, cos(); $y = cos( $x ); DESCRIPTION: Range reduction is into intervals of pi/4. The reduction error is nearly eliminated by contriving an extended precision modular arithmetic. Two polynomial approximating functions are employed. Between 0 and pi/4 the cosine is approximated by 1 - x**2 Q(x**2). Between pi/4 and pi/2 the sine is represented as x + x**3 P(x**2). ', 'ctan' => 'ctan: Complex circular tangent SYNOPSIS: # void ctan(); # cmplx z, w; $z = cmplx(2, 3); # $z = 2 + 3 i $w = $z->ctan; print $w->{r}, \' \', $w->{i}; # prints real and imaginary parts of $w print $w->as_string; # prints $w as Re(w) + i Im(w) DESCRIPTION: If z = x + iy, then sin 2x + i sinh 2y w = --------------------. cos 2x + cosh 2y On the real axis the denominator is zero at odd multiples of PI/2. The denominator is evaluated by its Taylor series near these points. ', 'cot' => 'cot: Circular cotangent SYNOPSIS: # double x, y, cot(); $y = cot( $x ); DESCRIPTION: Returns the circular cotangent of the radian argument x. Range reduction is modulo pi/4. A rational function x + x**3 P(x**2)/Q(x**2) is employed in the basic interval [0, pi/4]. ', 'asin' => 'asin: Inverse circular sine SYNOPSIS: # double x, y, asin(); $y = asin( $x ); DESCRIPTION: Returns radian angle between -pi/2 and +pi/2 whose sine is x. A rational function of the form x + x**3 P(x**2)/Q(x**2) is used for |x| in the interval [0, 0.5]. If |x| > 0.5 it is transformed by the identity asin(x) = pi/2 - 2 asin( sqrt( (1-x)/2 ) ). ', 'bdtr' => 'bdtr: Binomial distribution SYNOPSIS: # int k, n; # double p, y, bdtr(); $y = bdtr( $k, $n, $p ); DESCRIPTION: Returns the sum of the terms 0 through k of the Binomial probability density: k -- ( n ) j n-j > ( ) p (1-p) -- ( j ) j=0 The terms are not summed directly; instead the incomplete beta integral is employed, according to the formula $y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ). The arguments must be positive, with p ranging from 0 to 1. ', 'cosh' => 'cosh: Hyperbolic cosine SYNOPSIS: # double x, y, cosh(); $y = cosh( $x ); DESCRIPTION: Returns hyperbolic cosine of argument in the range MINLOG to MAXLOG. cosh(x) = ( exp(x) + exp(-x) )/2. ', 'sindg' => 'sindg: Circular sine of angle in degrees SYNOPSIS: # double x, y, sindg(); $y = sindg( $x ); DESCRIPTION: Range reduction is into intervals of 45 degrees. Two polynomial approximating functions are employed. Between 0 and pi/4 the sine is approximated by x + x**3 P(x**2). Between pi/4 and pi/2 the cosine is represented as 1 - x**2 P(x**2). ', 'k0' => 'k0: Modified Bessel function, third kind, order zero SYNOPSIS: # double x, y, k0(); $y = k0( $x ); DESCRIPTION: Returns modified Bessel function of the third kind of order zero of the argument. The range is partitioned into the two intervals [0,8] and (8, infinity). Chebyshev polynomial expansions are employed in each interval. ', 'k1' => 'k1: Modified Bessel function, third kind, order one SYNOPSIS: # double x, y, k1(); $y = k1( $x ); DESCRIPTION: Computes the modified Bessel function of the third kind of order one of the argument. The range is partitioned into the two intervals [0,2] and (2, infinity). Chebyshev polynomial expansions are employed in each interval. ', 'nbdtrc' => 'nbdtrc: Complemented negative binomial distribution SYNOPSIS: # int k, n; # double p, y, nbdtrc(); $y = nbdtrc( $k, $n, $p ); DESCRIPTION: Returns the sum of the terms k+1 to infinity of the negative binomial distribution: inf -- ( n+j-1 ) n j > ( ) p (1-p) -- ( j ) j=k+1 The terms are not computed individually; instead the incomplete beta integral is employed, according to the formula y = nbdtrc( k, n, p ) = incbet( k+1, n, 1-p ). The arguments must be positive, with p ranging from 0 to 1. ', 'iv' => 'iv: Modified Bessel function of noninteger order SYNOPSIS: # double v, x, y, iv(); $y = iv( $v, $x ); DESCRIPTION: Returns modified Bessel function of order v of the argument. If x is negative, v must be integer valued. The function is defined as Iv(x) = Jv( ix ). It is here computed in terms of the confluent hypergeometric function, according to the formula v -x Iv(x) = (x/2) e hyperg( v+0.5, 2v+1, 2x ) / gamma(v+1) If v is a negative integer, then v is replaced by -v. ' ); } sub get_descs { $topics{'trigs'} = "Help is available on the following functions: \n\n"; foreach (sort qw(asin acos atan atan2 sin cos tan cot hypot tandg cotdg sindg cosdg radian unity)) { (my $desc = $topics{$_}) =~ s!^(.*?\n).*!$1!s; $topics{'trigs'} .= $desc; } $topics{'hypers'} = "Help is available on the following functions: \n\n"; foreach (sort qw(acosh asinh atanh sinh cosh tanh) ) { (my $desc = $topics{$_}) =~ s!^(.*?\n).*!$1!s; $topics{'hypers'} .= $desc; } $topics{'explog'} = "Help is available on the following functions: \n\n"; foreach (sort qw(unity exp exp10 exp2 log log10 log2 expxx)) { (my $desc = $topics{$_}) =~ s!^(.*?\n).*!$1!s; $topics{'explog'} .= $desc; } $topics{'complex'} = "Help is available on the following functions: \n\n"; foreach (sort qw(clog cexp csin ccos ctan ccot casin cabs csqrt cacos catan cadd csub cmul cdiv cmov cneg cmplx csinh ccosh ctanh cpow casinh cacosh catanh) ) { (my $desc = $topics{$_}) =~ s!^(.*?\n).*!$1!s; $topics{'complex'} .= $desc unless $desc =~ /^\s*$/;; } $topics{'utils'} = "Help is available on the following functions: \n\n"; foreach (sort qw(ceil floor frexp ldexp fabs fac cbrt round sqrt lrand pow powi drand lsqrt ) ) { (my $desc = $topics{$_}) =~ s!^(.*?\n).*!$1!s; $topics{'utils'} .= $desc; } $topics{'bessels'} = "Help is available on the following functions: \n\n"; foreach (sort qw( i0 i0e i1 i1e iv j0 j1 jn jv k0 k1 kn yn yv k0e k1e y0 y1) ) { (my $desc = $topics{$_}) =~ s!^(.*?\n).*!$1!s; $topics{'bessels'} .= $desc; } $topics{'dists'} = "Help is available on the following functions: \n\n"; foreach (sort qw(bdtr bdtrc bdtri btdtr chdtr chdtrc chdtri fdtr fdtrc fdtri gdtr gdtrc nbdtr nbdtrc nbdtri ndtr ndtri pdtr pdtrc pdtri stdtr stdtri) ) { (my $desc = $topics{$_}) =~ s!^(.*?\n).*!$1!s; $topics{'dists'} .= $desc; } $topics{'gammas'} = "Help is available on the following functions: \n\n"; foreach (sort qw(gamma igam igamc igami psi fac rgamma) ) { (my $desc = $topics{$_}) =~ s!^(.*?\n).*!$1!s; $topics{'gammas'} .= $desc; } $topics{'betas'} = "Help is available on the following functions: \n\n"; foreach (sort qw( beta lbeta incbet incbi) ) { (my $desc = $topics{$_}) =~ s!^(.*?\n).*!$1!s; $topics{'betas'} .= $desc; } $topics{'elliptics'} = "Help is available on the following functions: \n\n"; foreach (sort qw(ellie ellik ellpe ellpj ellpk) ) { (my $desc = $topics{$_}) =~ s!^(.*?\n).*!$1!s; $topics{'elliptics'} .= $desc; } $topics{'hypergeometrics'} = "Help is available on the following functions: \n\n"; foreach (sort qw(onef2 threef0 hyp2f1 hyperg hyp2f0) ) { (my $desc = $topics{$_}) =~ s!^(.*?\n).*!$1!s; $topics{'hypergeometrics'} .= $desc; } $topics{'misc'} = "Help is available on the following functions: \n\n"; foreach (sort qw(zeta zetac airy dawsn fresnl sici shichi expn spence ei erfc erf struve plancki polylog bernum) ) { (my $desc = $topics{$_}) =~ s!^(.*?\n).*!$1!s; $topics{'misc'} .= $desc; } } sub cpl { my $word = shift; my @possibilities; if (! $word) { @possibilities = qw(constants trigs hypers explog complex utils bessels dists gammas betas elliptics hypergeometrics misc frac help setprec); } else { @possibilities = grep /^\Q$word\E/, @topics; } return @possibilities; } sub gnu_cpl { my $word = shift; my @possibilities = cpl($word); $attribs->{completion_word} = \@possibilities; return; } sub search_pagers { push @pagers, $Config{pager}; if ($^O =~ /Win32/) { push @pagers, qw( more less notepad ); unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; } elsif ($^O eq 'VMS') { push @pagers, qw( most more less type/page ); } elsif ($^O eq 'os2') { unshift @pagers, 'less', 'cmd /c more <'; } else { if ($^O eq 'os2') { unshift @pagers, 'less', 'cmd /c more <'; } push @pagers, qw( more less pg view cat ); unshift @pagers, $ENV{PAGER} if $ENV{PAGER}; } } __END__ =head1 NAME pmath - simple command line interface to Math::Cephes =head1 SYNOPSIS bash> pmath Interactive interface to the Math::Cephes module. TermReadLine enabled. Type 'help' or '?' for help. pmath> setprec 4 display set to 4 decimal places pmath> cos($PI) -1.0000 pmath> acos(%) 3.1416 pmath> q bash> =head1 DESCRIPTION This script provides a simple command line interface to the C module. If available, it will use the C and C or C modules to provide command line history and word completion. Typing C or C alone will provide a list of help topics grouped by major category name. C will provide a listing and short description of each function within the named category. C will provide a description and synopsis of the named function. Entering an expression that returns a single value, such as C, or one that returns multiple values, such as C, will result in all return values being printed. The last (successful) single value returned is saved as the C<%> symbol (as in Maple), so that one can do pmath> sin($PI/2) 1 pmath> asin(%) 1.570796 pmath> The number of decimal places displayed can be set to C using C: pmath> setprec 8 display set to 8 decimal places pmath> $PI 3.14159265 pmath> Multiple statements can be entered on a line, such as pmath> $x=1; $y=exp($x); printf("\texp(%5.2f)=%5.2f\n",$x,$y); exp( 1.00)= 2.72 pmath> or on multiple lines using C<\> as a continuation signal: pmath> $x = 1; \ $y = exp($x); \ printf("exp(%5.2f)=%5.2f\n", $x, $y); exp( 1.00)= 2.72 pmath> To quit the program, enter C, C, or C. The C module has some support for handling fractions and complex numbers through the C and C modules. For fractions, one can use the C function to create a fraction object, and then use these in a fraction routine: pmath> $f=fract(1,3); $g=fract(4,3); $f->radd($g); 5/3 pmath> mixed(%) 1 2/3 pmath> Similarly, for complex numbers one can use the C function to create a complex number object, and then use these in a complex number routine: pmath> $f=cmplx(1,3); $g=cmplx(4,3); $f->cadd($g); 5+6 i pmath> See L for an interface to some polynomial routines, and L for some matrix routines. =head1 BUGS Probably. Please report any to Randy Kobes =head1 SEE ALSO L, L, L, L and L. =head1 COPYRIGHT This script is copyrighted, 2000, 2002, by Randy Kobes. It may be distributed under the same terms as Perl itself. =cut Math-Cephes-0.5306/arrays.c0000644000175000017500000004602114757021403015244 0ustar shlomifshlomif/* Library of typemap functions for C arrays, idea is to provide automatic conversion between references to perl arrays and C arrays. If the argument is a scalar this is automatically detected and handles as a one element array. Thanks go to Tim Bunce for the pointer to gv.h so I could figure out how to handle glob values. Karl Glazebrook [kgb@aaoepp.aao.gov.au] Dec 95: Add double precision arrays - frossie@jach.hawaii.edu Dec 96: Add 'ref to scalar is binary' handling - kgb@aaoepp.aao.gov.au Jan 97: Handles undefined values as zero - kgb@aaoepp.aao.gov.au Feb 97: Fixed a few type cast howlers+bugs - kgb@aaoepp.aao.gov.au Apr 97: Add support for unsigned char and shorts- timj@jach.hawaii.edu */ #include "EXTERN.h" /* std perl include */ #include "perl.h" /* std perl include */ #include "XSUB.h" /* XSUB include */ /* Functions defined in this module, see header comments on each one for more details: */ #include "arrays.h" int is_scalar_ref (SV* arg) { /* Utility to determine if ref to scalar */ SV* foo; if (!SvROK(arg)) return 0; foo = SvRV(arg); if (SvPOK(foo)) return 1; else return 0; } /* #################################################################################### pack1D - argument is perl scalar variable and one char pack type. If it is a reference to a 1D array pack it and return pointer. If it is a glob pack the 1D array of the same name. If it is a scalar pack as 1 element array. If it is a reference to a scalar then assume scalar is prepacked binary data [1D-ness is checked - routine croaks if any of the array elements themselves are references.] Can be used in a typemap file (uses mortal scratch space and perl arrays know how big they are), e.g.: TYPEMAP int * T_INTP float * T_FLOATP double * T_DOUBLEP INPUT T_INTP $var = ($type)pack1D($arg,'i') T_FLOATP $var = ($type)pack1D($arg,'f') T_DOUBLEP $var = ($type)pack1D($arg,'d') */ void* pack1D ( SV* arg, char packtype ) { int iscalar; float scalar; double dscalar; short sscalar; unsigned char uscalar; AV* array; I32 i,n; SV* work; SV** work2; double nval; STRLEN len; if (is_scalar_ref(arg)) /* Scalar ref */ return (void*) SvPV(SvRV(arg), len); if (packtype!='f' && packtype!='i' && packtype!='d' && packtype!='s' && packtype != 'u') croak("Programming error: invalid type conversion specified to pack1D"); /* Create a work char variable - be cunning and make it a mortal *SV which will go away automagically when we leave the current context, i.e. no need to malloc and worry about freeing - thus we can use pack1D in a typemap! */ work = sv_2mortal(newSVpv("", 0)); /* Is arg a scalar? Return scalar*/ if (!SvROK(arg) && SvTYPE(arg)!=SVt_PVGV) { if (packtype=='f') { scalar = (float) SvNV(arg); /* Get the scalar value */ sv_setpvn(work, (char *) &scalar, sizeof(float)); /* Pack it in */ } if (packtype=='i') { iscalar = (int) SvNV(arg); /* Get the scalar value */ sv_setpvn(work, (char *) &iscalar, sizeof(int)); /* Pack it in */ } if (packtype=='d') { dscalar = (double) SvNV(arg); /*Get the scalar value */ sv_setpvn(work, (char *) &dscalar, sizeof(double)); /* Pack it in */ } if (packtype=='s') { sscalar = (short) SvNV(arg); /*Get the scalar value */ sv_setpvn(work, (char *) &sscalar, sizeof(short)); /* Pack it in */ } if (packtype=='u') { uscalar = (unsigned char) SvNV(arg); /*Get the scalar value */ sv_setpvn(work, (char *) &uscalar, sizeof(char)); /* Pack it in */ } return (void *) SvPV(work, PL_na); /* Return the pointer */ } /* Is it a glob or reference to an array? */ if (SvTYPE(arg)==SVt_PVGV || (SvROK(arg) && SvTYPE(SvRV(arg))==SVt_PVAV)) { if (SvTYPE(arg)==SVt_PVGV) { array = (AV *) GvAVn((GV*) arg); /* glob */ }else{ array = (AV *) SvRV(arg); /* reference */ } n = av_len(array); if (packtype=='f') SvGROW( work, sizeof(float)*(n+1) ); /* Pregrow for efficiency */ if (packtype=='i') SvGROW( work, sizeof(int)*(n+1) ); if (packtype=='d') SvGROW( work, sizeof(double)*(n+1) ); if (packtype=='s') SvGROW( work, sizeof(short)*(n+1) ); if (packtype=='u') SvGROW( work, sizeof(char)*(n+1) ); /* Pack array into string */ for(i=0; i<=n; i++) { work2 = av_fetch( array, i, 0 ); /* Fetch */ if (work2==NULL) nval = 0.0; /* Undefined */ else { if (SvROK(*work2)) goto errexit; /* Croak if reference [i.e. not 1D] */ nval = SvNV(*work2); } if (packtype=='f') { scalar = (float) nval; sv_catpvn( work, (char *) &scalar, sizeof(float)); } if (packtype=='i') { iscalar = (int) nval; sv_catpvn( work, (char *) &iscalar, sizeof(int)); } if (packtype=='d') { dscalar = (double) nval; sv_catpvn( work, (char *) &dscalar, sizeof(double)); } if (packtype=='s') { sscalar = (short) nval; sv_catpvn( work, (char *) &sscalar, sizeof(short)); } if (packtype=='u') { uscalar = (unsigned char) nval; sv_catpvn( work, (char *) &uscalar, sizeof(char)); } } /* Return a pointer to the byte array */ return (void *) SvPV(work, PL_na); } errexit: croak("Routine can only handle scalar values or refs to 1D arrays of scalars"); } /* ##################################################################################### pack2D - argument is perl scalar variable and one char pack type. If it is a reference to a 1D/2D array pack it and return pointer. If it is a glob pack the 1D/2D array of the same name. If it is a scalar assume it is a prepacked array and return pointer to char part of scalar. If it is a reference to a scalar then assume scalar is prepacked binary data [2Dness is checked - program croaks if any of the array elements themselves are references. Packs each row sequentially even if they are not all the same dimension - it is up to the programmer to decide if this is sensible or not.] Can be used in a typemap file (uses mortal scratch space and perl arrays know how big they are), e.g.: TYPEMAP int2D * T_INT2DP float2D * T_FLOAT2DP INPUT T_INT2DP $var = ($type)pack2D($arg,'i') T_FLOAT2DP $var = ($type)pack2D($arg,'f') [int2D/float2D would be typedef'd to int/float] */ void* pack2D ( SV* arg, char packtype ) { int iscalar; float scalar; short sscalar; double dscalar; unsigned char uscalar; AV* array; AV* array2; I32 i,j,n,m; SV* work; SV** work2; double nval; int isref; STRLEN len; if (is_scalar_ref(arg)) /* Scalar ref */ return (void*) SvPV(SvRV(arg), len); if (packtype!='f' && packtype!='i' && packtype!='d' && packtype!='s' && packtype!='u') croak("Programming error: invalid type conversion specified to pack2D"); /* Is arg a scalar? Return pointer to char part */ if (!SvROK(arg) && SvTYPE(arg)!=SVt_PVGV) { return (void *) SvPV(arg, PL_na); } /* Create a work char variable - be cunning and make it a mortal *SV which will go away automagically when we leave the current context, i.e. no need to malloc and worry about freeing - thus we can use pack2D in a typemap! */ work = sv_2mortal(newSVpv("", 0)); /* Is it a glob or reference to an array? */ if (SvTYPE(arg)==SVt_PVGV || (SvROK(arg) && SvTYPE(SvRV(arg))==SVt_PVAV)) { if (SvTYPE(arg)==SVt_PVGV) { array = GvAVn((GV*) arg); /* glob */ }else{ array = (AV *) SvRV(arg); /* reference */ } n = av_len(array); /* Pack array into string */ for(i=0; i<=n; i++) { /* Loop over 1st dimension */ work2 = av_fetch( array, i, 0 ); /* Fetch */ isref = work2!=NULL && SvROK(*work2); /* Is is a reference */ if (isref) { array2 = (AV *) SvRV(*work2); /* array of 2nd dimension */ m = av_len(array2); /* Length */ }else{ m=0; /* 1D array */ nval = SvNV(*work2); } /* Pregrow storage for efficiency on first row - note assumes array is rectangular but better than nothing */ if (i==0) { if (packtype=='f') SvGROW( work, sizeof(float)*(n+1)*(m+1) ); if (packtype=='i') SvGROW( work, sizeof(int)*(n+1)*(m+1) ); if (packtype=='s') SvGROW( work, sizeof(short)*(n+1)*(m+1) ); if (packtype=='u') SvGROW( work, sizeof(char)*(n+1)*(m+1) ); if (packtype=='d') SvGROW( work, sizeof(double)*(n+1)*(m+1) ); } for(j=0; j<=m; j++) { /* Loop over 2nd dimension */ if (isref) { work2 = av_fetch( array2, j, 0 ); /* Fetch element */ if (work2==NULL) nval = 0.0; /* Undefined */ else { if (SvROK(*work2)) goto errexit; /* Croak if reference [i.e. not 1D] */ nval = SvNV(*work2); } } if (packtype=='d') { dscalar = (double) nval; sv_catpvn( work, (char *) &dscalar, sizeof(double)); } if (packtype=='f') { scalar = (float) nval; sv_catpvn( work, (char *) &scalar, sizeof(float)); } if (packtype=='i') { iscalar = (int) nval; sv_catpvn( work, (char *) &iscalar, sizeof(int)); } if (packtype=='s') { sscalar = (short) nval; sv_catpvn( work, (char *) &sscalar, sizeof(short)); } if (packtype=='u') { uscalar = (unsigned char) nval; sv_catpvn( work, (char *) &uscalar, sizeof(char)); } } } /* Return a pointer to the byte array */ return (void *) SvPV(work, PL_na); } errexit: croak("Routine can only handle scalar packed char values or refs to 1D or 2D arrays"); } /* ################################################################################### packND - argument is perl scalar variable and one char pack type. arg is treated as a reference to an array of arbitrary dimensions. Pointer to packed data is returned. It is packed recursively, i.e. if an element is a scalar it is packed on the end of the string, if it is a reference the array it points to is packed on the end with further recursive traversal. For a 2D input will produce the same result as pack2D though without, obviously, dimensional checking. Since we don't know in advance how big it is we can't preallocate the storage so this may be inefficient. Note, as in other pack routines globs are handled as the equivalent 1D array. e.g. [1,[2,2,[-4,-4]]],-1,0,1, 2,3,4] is packed as 1,2,2,-4,-4,-1,0,1,2,3,4 If arg is a reference to a scalar then assume scalar is prepacked binary data. Can be used in a typemap file (uses mortal scratch space). */ void* packND ( SV* arg, char packtype ) { SV* work; STRLEN len; void pack_element(SV* work, SV** arg, char packtype); /* Called by packND */ if (is_scalar_ref(arg)) /* Scalar ref */ return (void*) SvPV(SvRV(arg), len); if (packtype!='f' && packtype!='i' && packtype!='d' && packtype!='s' && packtype!='u') croak("Programming error: invalid type conversion specified to packND"); /* Create a work char variable - be cunning and make it a mortal *SV which will go away automagically when we leave the current context, i.e. no need to malloc and worry about freeing - thus we can use packND in a typemap! */ work = sv_2mortal(newSVpv("", 0)); pack_element(work, &arg, packtype); return (void *) SvPV(work, PL_na); } /* Internal function of packND - pack an element recursively */ void pack_element(SV* work, SV** arg, char packtype) { I32 i,n; AV* array; int iscalar; float scalar; short sscalar; unsigned char uscalar; double nval; /* Pack element arg onto work recursively */ /* Is arg a scalar? Pack and return */ if (arg==NULL || (!SvROK(*arg) && SvTYPE(*arg)!=SVt_PVGV)) { if (arg==NULL) nval = 0.0; else nval = SvNV(*arg); if (packtype=='f') { scalar = (float) nval; /* Get the scalar value */ sv_catpvn(work, (char *) &scalar, sizeof(float)); /* Pack it in */ } if (packtype=='i') { iscalar = (int) nval; /* Get the scalar value */ sv_catpvn(work, (char *) &iscalar, sizeof(int)); /* Pack it in */ } if (packtype=='d') { sv_catpvn(work, (char *) &nval, sizeof(double)); /* Pack it in */ } if (packtype=='s') { sscalar = (short) nval; /* Get the scalar value */ sv_catpvn(work, (char *) &sscalar, sizeof(short)); /* Pack it in */ } if (packtype=='u') { uscalar = (unsigned char) nval; sv_catpvn(work, (char *) &uscalar, sizeof(char)); /* Pack it in */ } return; } /* Is it a glob or reference to an array? */ if (SvTYPE(*arg)==SVt_PVGV || (SvROK(*arg) && SvTYPE(SvRV(*arg))==SVt_PVAV)) { /* Dereference */ if (SvTYPE(*arg)==SVt_PVGV) { array = GvAVn((GV*)*arg); /* glob */ }else{ array = (AV *) SvRV(*arg); /* reference */ } /* Pack each array element */ n = av_len(array); for (i=0; i<=n; i++) { /* To curse is human, to recurse divine */ pack_element(work, av_fetch(array, i, 0), packtype ); } return; } errexit: croak("Routine can only handle scalars or refs to N-D arrays of scalars"); } /* ################################################################################## unpack1D - take packed string (C array) and write back into perl 1D array. If 1st argument is a reference, unpack into this array. If 1st argument is a glob, unpack into the 1D array of the same name. Can only be used in a typemap if the size of the array is known in advance or is the size of a preexisting perl array (n=0). If it is determined by another variable you may have to put in in some direct CODE: lines in the XSUB file. */ void unpack1D ( SV* arg, void * var, char packtype, int n ) { /* n is the size of array var[] (n=1 for 1 element, etc.) If n=0 take var[] as having the same dimension as array referenced by arg */ int* ivar; float* fvar; double* dvar; short* svar; unsigned char* uvar; SV* work; AV* array; I32 i,m; /* Note in ref to scalar case data is already changed */ if (is_scalar_ref(arg)) /* Do nothing */ return; if (packtype!='f' && packtype!='i' && packtype!= 'd' && packtype!='u' && packtype!='s') croak("Programming error: invalid type conversion specified to unpack1D"); m=n; array = coerce1D( arg, m ); /* Get array ref and coerce */ if (m==0) m = av_len( array )+1; if (packtype=='i') /* Cast void array var[] to appropriate type */ ivar = (int *) var; if (packtype=='f') fvar = (float *) var; if (packtype=='d') dvar = (double *) var; if (packtype=='u') uvar = (unsigned char *) var; if (packtype=='s') svar = (short *) var; /* Unpack into the array */ for(i=0; i