cexprl.f 1.21 KB
complex function cexprl (z)
c august 1980 edition.  w. fullerton, c3, los alamos scientific lab.
c
c evaluate  (cexp(z)-1)/z .  for small cabs(z), we use the taylor
c series.  we could instead use the expression
c        cexprl(z) = (exp(x)*exp(i*y)-1)/z
c                  = (x*exprel(x) * (1 - 2*sin(y/2)**2) - 2*sin(y/2)**2
c                                    + i*sin(y)*(1+x*exprel(x))) / z
c
      complex z, cexp
      external  r1mach
      data nterms, rbnd, sqeps / 0, 2*0.0 /
c
      if (nterms.ne.0) go to 10
      alneps = alog(r1mach(3))
      xn = 3.72 - 0.3*alneps
      xln = alog((xn+1.0)/1.36)
      nterms = xn - (xn*xln+alneps)/(xln+1.36) + 1.5
      rbnd = r1mach(3)
      sqeps = 0.0
c
 10   r = cabs(z)
      if (r.le.0.5) go to 20
c
      call entsrc (irold, 1)
      cexprl = (cexp(z) - 1.0) / z
      call erroff
      call entsrc (irold2, irold)
      if (abs(real(z)).lt.sqeps .and. cabs(cexprl).lt.sqeps) call
     1  seteru (41hcexprl  answer lt half prec, z near ni2pi,
     2  41, 1, 1)
      return
c
 20   cexprl = (1.0, 0.0)
      if (r.lt.rbnd) return
c
      cexprl = (0.0, 0.0)
      do 30 i=1,nterms
        cexprl = 1.0 + cexprl*z/float(nterms+2-i)
 30   continue
c
      return
      end