Sindbad~EG File Manager

/* gamma and digamma functions of complex arguments */
/* 9.24.92 adapted from Baker's  C Mathematical Function Handbook */
/* 5.30.94  changed 'cdigamma' to 'Cdigamma'   */
/* 9.20.97 added export.h 
   5.4.13  added stdlib.h
   10.22.23 prototype of log at line 23
*/


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

#include "dcomplex.h"
#include "baker.h"

dcomplex Cgamma(dcomplex zz, dcomplex *loggam)
 /* best of the bunch- from CALGO 404 Lucas and Terrill */
 /* returns the answer or 'badval', defined in cbessel.c */

{ dcomplex z,zm,t,tt,sum,term,den,a,aux;
  double c[12]={1./12.,-1./360.,1./1260.,
  -1./1680., 1./1188.,-691./360360.,1./156.,
  -3617./122400.,43867./244188.,-174611./1125400., 77683./5796.};
  double x,y,tol=1.e-7,xdist;
  double log(double);
  int flip=0;
  int i,m,reflect;
  z = zz;
  x=z.r;
  y=z.i;
  reflect=0;
  if( x<tol )
     {  xdist = x- ((int)(x-.5));
        CMPLX(zm,xdist,y);
        if(Cabs(zm)<tol)
           return badval;
        if(x<0.)
           { reflect=1;
             x=1.-x;
             y=-y;
             CMPLX(z,1.,0.);
             CSUB(z,z,zz);
           }
     }
  if(y<0.)
     { flip=1;
       y=-y;
       z.i=y;
     }
  m=0;
  while(x<10.)
    { x+=1.;
      m++;
    }
  while( y >= x)
    { x+=1.;
      m++;
    }
  CMPLX(t,x,y);
  CMULT(tt,t,t);
  den = t;
  CMPLX(aux,.5,0.);
  CSUB(aux,t,aux);
  zm = Cln(t);
  CMULT(sum,aux,zm);
  CSUB(sum,sum,t);
  sum.r+= .5*log(2.*PI_DECIMAL);
  for(i=0;i<11;i++)
    { CMPLX(aux,c[i],0.);
      CDIV(term,aux,den);
      if(fabs(term.r)<fabs(sum.r)*tol)
         {
           if(y==0. ||(fabs(term.i)>=fabs(sum.i) ) )
               break;
         }
      CADD(sum,sum,term);
      CMULT(aux,den,tt);
      den = aux;
    }
 if(m)
    { for(i=0;i<m;i++)
         { CMPLX(a, (double)i,0.);
           CADD(a,a,z);
           aux = Cln(a);
           CSUB(sum,sum,aux);
         }
    }
 if(reflect)
    { CMPLX(aux,PI_DECIMAL,0.);
      CTREAL(t,z,PI_DECIMAL);
      tt = Csin(t);
      CDIV(den,aux,tt);
      aux = Cln(den);
      CSUB(sum,aux,sum);
    }
 if(flip) {sum.i=-sum.i;}
 *loggam = sum;
 return Cexp(sum);
 }

/*________________________________________________________________*/

dcomplex Cdigamma(dcomplex x)
{ dcomplex q,y,z,sum,rq,one,ans;
  double digammin = 20.;  /* Baker has this global, God knows where it is
                             supposed to come from. */
  if(x.r==1. && x.i==0.)
    { CMPLX(ans, - Egamma ,0.);
      return ans;
    }
  q = x;CMPLX(sum,0.,0.);CMPLX(one,1.,0.);
  if(q.r < 0.)
    {   if( abs((int)(q.r)-q.r && q.i==0.) <1.e-8)
             return badval;
        CSUB(q,one,x);
        CTREAL(rq,x,PI_DECIMAL);
        sum = Ccot(rq);
        CTREAL(sum,sum,PI_DECIMAL);
    }
        /*note sum subtracted from final result*/
  while(q.r<digammin)
    {   if(q.r==0. && q.i==0.)
           return badval;
        CDIV(rq,one,q);CADD(sum,sum,rq);
        q.r+=1.;
    }
  CDIV(y,one,q);/*y=1/q*/;
  CMULT(z,y,y);
  rq = Cln(q);
/* logx-1/2x- sum n=1 to inf of  B[2n]z^-2n/2n*/
  CSUB(ans,rq,sum);
  CTREAL(rq,y,-.5);
  CADD(ans,ans,rq);
  sum = z;
  CTREAL(sum,sum,-1./240.);
  sum.r+=1./252.;
  CMULT(rq,sum,z);
  rq.r-= 1./120.;
  CMULT(sum,rq,z); sum.r+=1./12.; CMULT(rq,sum,z);
  CSUB(ans,ans,rq);
  return ans;
}