complex function c9lgmc (zin) c april 1978 edition. w. fullerton c3, los alamos scientific lab. c c compute the log gamma correction term for large cabs(z) when real(z) c .ge. 0.0 and for large abs(aimag(y)) when real(z) .lt. 0.0. we find c c9lgmc so that c clog(cgamma(z)) = 0.5*alog(2.*pi) + (z-0.5)*clog(z) - z + c9lgmc(z). c complex zin, z, z2inv external alog, cabs, exp, r1mach, sqrt c dimension bern(11) data bern( 1) / .08333333333 3333333e0 / data bern( 2) / -.002777777777 7777778e0 / data bern( 3) / .0007936507936 5079365e0 / data bern( 4) / -.0005952380952 3809524e0 / data bern( 5) / .0008417508417 5084175e0 / data bern( 6) / -.001917526917 5269175e0 / data bern( 7) / .006410256410 2564103e0 / data bern( 8) / -.02955065359 4771242e0 / data bern( 9) / .1796443723 6883057e0 / data bern(10) / -1.392432216 9059011e0 / data bern(11) / 13.40286404 4168392e0 / c data nterm, bound, xbig, xmax / 0, 3*0.0 / c if (nterm.ne.0) go to 10 c nterm = -0.30*alog(r1mach(3)) bound = 0.1170*float(nterm)* 1 (0.1*r1mach(3))**(-1./(2.*float(nterm)-1.)) xbig = 1.0/sqrt(r1mach(3)) xmax = exp (amin1(alog(r1mach(2)/12.0), -alog(12.*r1mach(1))) ) c 10 z = zin x = real (z) y = aimag(z) cabsz = cabs(z) c if (x.lt.0.0 .and. abs(y).lt.bound) call seteru ( 69hc9lgmc c9lgm 1c not valid for negative real(z) and small abs(aimag(z)), 69, 2,2) if (cabsz.lt.bound) call seteru ( 1 42hc9lgmc c9lgmc not valid for small cabs(z), 42, 3, 2) c if (cabsz.ge.xmax) go to 50 c if (cabsz.ge.xbig) c9lgmc = 1.0/(12.0*z) if (cabsz.ge.xbig) return c z2inv = 1.0/z**2 c9lgmc = (0.0, 0.0) do 40 i=1,nterm ndx = nterm + 1 - i c9lgmc = bern(ndx) + c9lgmc*z2inv 40 continue c c9lgmc = c9lgmc/z return c 50 c9lgmc = (0.0, 0.0) call seteru (34hc9lgmc z so big c9lgmc underflows, 34, 1, 0) return c end