Sindbad~EG File Manager

/* complex arithmetic and elementary transcendental functions */
/* M. Beeson, for Mathpert; first part adapted from Numerical Recipes
   Original date 7.11.91
   Code last modified 4.23.93
   11.17.93 added math.h
   7.11.94 added EXPORTs
  10.17.94 modified to check for overflow
  2.6.97  Corrected CAtan--there is an error in Abramowitz and Stegun!
  9.18.97 MEXPORT_DEVAL
  1.29.98 last modified
  4.7.06 changed hypot to _hypot
  5.4.13  put in conditional compilation for hypot and _hypot
          added stdlib.h
*/

#include <math.h>
#include <stdlib.h>  // for abs in C99 

#include "terms.h"
#include "dcomplex.h"
#include "special.h"
#include "deval.h"

#ifdef XCODE
#define _hypot hypot
#endif 

#define MAXEXP  400  /* maximum power of 2 allowed in quotient */

dcomplex Cplus(dcomplex a,dcomplex b)
 /* the name 'cadd' is used in arith.c for something else */
{ dcomplex c;
  c.r=a.r+b.r;
  c.i=a.i+b.i;
  return c;
}

dcomplex Csub(dcomplex a,dcomplex b)
{ dcomplex c;
  c.r=a.r-b.r;
  c.i=a.i-b.i;
  return c;
}

dcomplex Cmul(dcomplex a,dcomplex b)
{ dcomplex c;
  c.r=a.r*b.r-a.i*b.i;
  c.i=a.i*b.r+a.r*b.i;
  return c;
}

dcomplex Cdiv(dcomplex a,dcomplex b)
{ dcomplex c;
  int checknum, checkden;
  double r,num,den;
  if (fabs(b.r) >= fabs(b.i))
     { r=b.i/b.r;
       den=b.r+r*b.i;
       num = a.r + r*a.i;
       /* Check for overflow before dividing */
       if(den == 0.0)
          { /* in this case frexp won't be large so must
               catch this case separately */
            c.r = BADVAL;
            c.i = 0;
            return c;
          }
       frexp(den,&checkden);
       frexp(num,&checknum);
       if(abs(checkden-checknum) > MAXEXP)
          { c.r = BADVAL;
            c.i = 0;
            return c;
          }
       c.r = num/den;
       num = a.i-r*a.r;
       frexp(num,&checknum);
       if(abs(checkden-checknum) > MAXEXP)
          { c.r = BADVAL;
            c.i = 0;
            return c;
          }
       c.i = num/den;
     }
  else
     { r=b.r/b.i;
       den=b.i+r*b.r;
       num = a.r*r + a.i;
      /* Check for overflow before dividing */
       frexp(den,&checkden);
       frexp(num,&checknum);
       if(abs(checkden-checknum) > MAXEXP)
          { c.r = BADVAL;
            c.i = 0;
            return c;
          }
       c.r = num/den;
       num = a.i*r-a.r;
       frexp(num,&checknum);
       if(abs(checkden-checknum) > MAXEXP)
          { c.r = BADVAL;
            c.i = 0;
            return c;
          }
       c.i = num/den;
     }
  return c;
}

double Cabs(dcomplex z)
{ double x,y,ans,temp;
  x=fabs(z.r);
  y=fabs(z.i);
  if (x == 0.0)
     ans=y;
  else if (y == 0.0)
     ans=x;
  else if (x > y)
     { temp=y/x;
       ans=x*sqrt(1.0+temp*temp);
     }
  else
     { temp=x/y;
       ans=y*sqrt(1.0+temp*temp);
     }
  return ans;
}

dcomplex Csqrt(dcomplex z)
{ dcomplex c;
  double x,y,w,r;
  if ((z.r == 0.0) && (z.i == 0.0))
     { c.r=0.0;
       c.i=0.0;
       return c;
     }
  else
     { x=fabs(z.r);
       y=fabs(z.i);
       if (x >= y)
          { r=y/x;
            w=sqrt(x)*sqrt(0.5*(1.0+sqrt(1.0+r*r)));
          }
       else
          { r=x/y;
            w=sqrt(y)*sqrt(0.5*(r+sqrt(1.0+r*r)));
          }
       if (z.r >= 0.0)
          { c.r=w;
            c.i=z.i/(2.0*w);
          }
       else
          { c.i=(z.i >= 0) ? w : -w;
            c.r=z.i/(2.0*c.i);
          }
      return c;
    }
}

dcomplex RCmul(double x,dcomplex a)
{ dcomplex c;
  c.r=x*a.r;
  c.i=x*a.i;
  return c;
}

dcomplex make_dcomplex(double x, double y)
{ dcomplex c;
  c.r = x;
  c.i = y;
  return c;
}

/*_____End of the part adapted from Numerical Recipes ______________________*/

dcomplex Cneg(dcomplex x)
/* the name 'cnegate' is used in arith.c for something else */
{  dcomplex c;
   c.r = x.r == 0.0 ? 0.0 : -x.r;   /* don't create -0.0 */
   c.i = x.i == 0.0 ? 0.0 : -x.i;
   return c;
}

dcomplex Cexp(dcomplex z)
/* e^(x+iy) = e^x  cos y + i e^x sin y */
{ dcomplex c;
  double x = z.r;
  double y = z.i;
  double r = exp(x);
  c.r = r * cos(y);
  c.i = r * sin(y);
  return c;
}

double  Carg(dcomplex z)
{ return atan2(z.i,z.r);
}

dcomplex Crecip(dcomplex z)
{ return Cdiv(make_dcomplex(1.0,0.0),z);
}

dcomplex Cln(dcomplex z)
/*  ln(z) = ln(Cabs(z) + i Carg(z) */
{ dcomplex c;
  c.r = log(Cabs(z));
  c.i = Carg(z);
  return c;
}

dcomplex Cpower(dcomplex u, dcomplex v)
/* u^v = e^(v ln u) = */
/* Does not check for 0^0 */
{ if(u.r == 0.0 && u.i == 0.0)
     return make_dcomplex(0.0,0.0);
  if(v.r == 0.0 && v.i == 0.0)
     return make_dcomplex(1.0,0.0);
  return Cexp(Cmul(v,Cln(u)));
}

dcomplex Croot(dcomplex n, dcomplex z)
/* compute root(n,z) */
{ return Cpower(z, Crecip(n));
}

dcomplex Ccos(dcomplex z)
{ dcomplex c,u,v;
  u.r = - z.i;
  u.i = z.r;   /* u =  iz */
  v.r = z.i;
  v.i = -z.r;  /* v = -iz */
  c = Cplus(Cexp(u),Cexp(v));
  c.r *= 0.5;
  c.i *= 0.5;
  return c;
}

dcomplex Csin(dcomplex z)
{ dcomplex c,u,v;
  double temp;
  u.r = - z.i;
  u.i = z.r;   /* u =  iz */
  v.r = z.i;
  v.i = -z.r;  /* v = -iz */
  c = Csub(Cexp(u),Cexp(v));
  c.r *= 0.5;
  c.i *= 0.5;
  temp = c.i;
  c.i = - c.r;
  c.r = temp;    /* divide c by i, that is, multiply by -i */
  return c;
}

void Ctrig(dcomplex z, dcomplex *cc, dcomplex *ss)
/* return indirectly cos z and sin z simultaneously */
{ dcomplex c,u,v,expu,expv;
  double temp;
  dcomplex ctemp;
  u.r = - z.i;
  u.i = z.r;   /* u =  iz */
  v.r = z.i;
  v.i = -z.r;  /* v = -iz */
  expu = Cexp(u);
  expv = Cexp(v);
  c = Csub(expu,expv);
  c.r *= 0.5;
  c.i *= 0.5;
  temp = c.i;
  ss->i = - c.r;
  ss->r = temp;    /* divide c by i, that is, multiply by -i */
  /* Now compute cos z */
  ctemp = Cplus(expu,expv);
  cc->i = 0.5 * ctemp.i;
  cc->r = 0.5 * ctemp.r;
}


dcomplex Ctan(dcomplex z)
{ return Cdiv(Csin(z),Ccos(z));
}

dcomplex Csec(dcomplex z)
{ return Crecip(Ccos(z));
}

dcomplex Ccsc(dcomplex z)
{ return Crecip(Csin(z));
}

dcomplex Ccot(dcomplex z)
{ return Cdiv(Ccos(z),Csin(z));   /* not 1/tan as that can't give zero */
}

dcomplex Ccosh(dcomplex z)
{ return RCmul(0.5, Cplus(Cexp(z),Cexp(Cneg(z))));
}

dcomplex Csinh(dcomplex z)
{ return RCmul(0.5, Csub(Cexp(z),Cexp(Cneg(z))));
}

dcomplex Ctanh(dcomplex z)
{ return Cdiv(Csinh(z),Ccosh(z));
}


/* The following formulas for complex inverse trig functions
are taken from pages 80-81 of Handbook of Mathematical Functions,
published by Dover.  I guess not too many mathematicians know these!
*/

dcomplex Cacos(dcomplex z)
/* real part returned in same range as acos */
{ double alpha,beta,x,y,u,v;
  dcomplex c;
  x = z.r;
  y = z.i;
  u = 0.5 * _hypot(x+1,y);
  v = 0.5 * _hypot(x-1,y);
  alpha = u + v;
  beta =  u - v;
  c.r = acos(beta);
  c.i = -log(alpha + _hypot(alpha, sqrt(alpha * alpha -1.0)));
  return c;
}

dcomplex Casin(dcomplex z)
/* real part returned in same range as asin */
{ double alpha,beta,x,y,u,v;
  dcomplex c;
  x = z.r;
  y = z.i;
  u = 0.5 * _hypot(x+1,y);
  v = 0.5 * _hypot(x-1,y);
  alpha = u + v;
  beta =  u - v;
  c.r = asin(beta);
  c.i = log(alpha + _hypot(alpha, sqrt(alpha * alpha -1.0)));
  return c;
}

dcomplex Catan(dcomplex z)
/* real part returned in same range as atan  */
/* See Abramowitz and Stegun 4.4.39, page 81 */
/* But I think Abramowitz and Stegun have it wrong;
   it should be k pi/2  where they have k pi.
   Consider the case y = 0.  Then the identity boils down to
   arctan x = (1/2) arctan(2x/(1-x^2) + k pi/2,
   not k pi as A & S would have it, e.g. when x = 2 we have
   arctan 2 = (1/2) arctan(4/(-3)) + pi/2 = pi_term/2 - (1/2)arctan(4/3) = 1.107
*/
{ dcomplex c;
  double x,y,u,num,den,t;
  x = z.r;
  y = z.i;
  u = x*x;
  if(y == 0.0)
    { c.r = atan(x);
      c.i = 0.0;
      return c;
    }
  num = u + (y+1)*(y+1);
  den = u + (y-1)*(y-1);
  c.i = 0.25 * log(num/den);
  t = 1-u-y*y;
  if(fabs(t) < VERYSMALL) /* assume it was meant to be zero */
     c.r = PI_DECIMAL/4.0;
  else if(t > 0.0)
     c.r = 0.5 * atan(2*x/t);
  else
     c.r = 0.5 * (atan(2*x/t) + PI_DECIMAL);
  return c;
}