complex(kind(1.d0)) function z9lgmc (zin) implicit none 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(kind(1.d0)) zin, z, z2inv real(kind(1.d0)) d1mach,bern,xbig,xmax,bound,cabsz,x,y integer nterm,i,ndx external d1mach c dimension bern(11) data bern( 1) / .08333333333 3333333d0 / data bern( 2) / -.002777777777 7777778d0 / data bern( 3) / .0007936507936 5079365d0 / data bern( 4) / -.0005952380952 3809524d0 / data bern( 5) / .0008417508417 5084175d0 / data bern( 6) / -.001917526917 5269175d0 / data bern( 7) / .006410256410 2564103d0 / data bern( 8) / -.02955065359 4771242d0 / data bern( 9) / .1796443723 6883057d0 / data bern(10) / -1.392432216 9059011d0 / data bern(11) / 13.40286404 4168392d0 / c data nterm, bound, xbig, xmax / 0d0, 3*0.0d0 / c if (nterm.ne.0) go to 10 c nterm = -0.30*log(d1mach(3)) bound = 0.1170*dble(nterm)* 1 (0.1*d1mach(3))**(-1./(2.*dble(nterm)-1.)) xbig = 1.0/sqrt(d1mach(3)) xmax = exp (min(log(d1mach(2)/12.0), -log(12.*d1mach(1))) ) c 10 z = zin x = real (z) y = aimag(z) cabsz = abs(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 42hz9lgmc z9lgmc not valid for small cabs(z), 42, 3, 2) c if (cabsz.ge.xmax) go to 50 c if (cabsz.ge.xbig) z9lgmc = 1.0/(12.0*z) if (cabsz.ge.xbig) return c z2inv = 1.0/z**2 z9lgmc = (0.0, 0.0) do 40 i=1,nterm ndx = nterm + 1 - i z9lgmc = bern(ndx) + z9lgmc*z2inv 40 continue c z9lgmc = z9lgmc/z return c 50 z9lgmc = (0.0, 0.0) call seteru (34hz9lgmc z so big z9lgmc underflows, 34, 1, 0) return c end