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