subroutine msetup (ndig)
c
c initialize for precision of ndig decimal digits.  NDIG
c must be .le. 200 for the given register array R.
c
      common /mpcom / b, t, m, lun, mxr, ipar(18)
      common // r(3277)
      integer b, t, m, lun, mxr, r
c
      call mpset (6, ndig, 1000, 3277)
c
      nd = float(t-1) * alog10(float(b)) + 0.5
      write (lun, 10) nd, b, t, m, lun, mxr
 10   format ('1  multiple precision package initialized with'
     1 //1x, i10, ' Decimal digits precision'
     2  /1x, i10, ' Base'
     3  /1x, i10, ' Words of precision'
     4  /1x, i10, ' Maximum exponent'
     5  /1x, i10, ' Standard output unit'
     6  /1x, i10, ' Words in register storage')
c
      return
      end
      subroutine mcopy (ix, iz)
      common /cstak / istak(1000)
      call mpstr (istak(ix), istak(iz))
      return
      end
      subroutine malc (ix)
      common /mpcom / b, t, m, lun, mxr, ipar(18)
      integer b, t, m, lun, mxr
      ix = istkgt (t+2, 2)
      return
      end
      subroutine malcp (ix)
c allocate permanent storage for the multiple precision number at the
c top of the stack.
c
      common /mpcom / b, t, m, lun, mxr, ipar(18)
      integer b, t, m, lun, mxr
      ix = istkgt (t+2, -2)
      return
      end
      subroutine mdalc (ix)
      call istkrl (1)
      return
      end
      subroutine maalc (ix, n)
      common /mpcom / b, t, m, lun, mxr, ipar(18)
      integer b, t, m, lun, mxr, ix(n)
c
      if (n.lt.1) call seterr (17hmaalc   n is lt 0, 17, 1, 2)
c
      len = (t+2)*n
      ix(1) = istkgt (len, 2)
c
      if (n.lt.2) return
      do 10 i=2,n
        ix(i) = ix(i-1) + t + 2
 10   continue
c
      return
      end
      subroutine maalcp (ix, n)
      common /mpcom / b, t, m, lun, mxr, ipar(18)
      integer b, t, m, lun, mxr, ix(n)
c
      if (n.lt.1) call seterr (17hmaalcp  n is lt 0, 17, 1, 2)
c
      len = (t+2)*n
      ix(1) = istkgt (len, -2)
c
      if (n.lt.2) return
      do 10 i=2,n
        ix(i) = ix(i-1) + t + 2
 10   continue
c
      return
      end
      subroutine madalc (ix, n)
      integer ix(n)
      call istkrl (1)
      return
      end
      subroutine mitom (intger, iz)
      common /cstak / istak(1000)
      call mpcim (intger, istak(iz))
      return
      end
      subroutine metom (r, iz)
      common /cstak / istak(1000)
      call mpcrm (r, istak(iz))
      return
      end
      subroutine mdtom (d, iz)
      common /cstak / istak(1000)
      double precision d
      call mpcdm (d, istak(iz))
      return
      end
      subroutine mhtom (h, iz)
      common /cstak / istak(1000)
      integer h(1)
      call mpcam (h, istak(iz))
      return
      end
      integer function mmtoi (ix)
      common /cstak / istak(1000)
      call mpcmi (istak(ix), intger)
      mmtoi = intger
      return
      end
      real function mmtoe (ix)
      common /cstak / istak(1000)
      double precision d
      call mpcmd (istak(ix), d)
      mmtoe = d
      return
      end
      double precision function mmtod (ix)
      common /cstak / istak(1000)
      double precision d
      call mpcmd (istak(ix), d)
      mmtod = d
      return
      end
      subroutine madd (ix, iy, iz)
      common /cstak / istak(1000)
      call mpadd (istak(ix), istak(iy), istak(iz))
      return
      end
      subroutine msub (ix, iy, iz)
      common /cstak / istak(1000)
      call mpsub (istak(ix), istak(iy), istak(iz))
      return
      end
      subroutine mneg (ix, iz)
      common /cstak / istak(1000)
      call mpneg (istak(ix), istak(iz))
      return
      end
      subroutine mmul (ix, iy, iz)
      common /cstak / istak(1000)
      call mpmul (istak(ix), istak(iy), istak(iz))
      return
      end
      subroutine mmul1 (intger, iy, iz)
      common /cstak / istak(1000)
      call mpmuli (istak(iy), intger, istak(iz))
      return
      end
      subroutine mmul2 (ix, intger, iz)
      common /cstak / istak(1000)
      call mpmuli (istak(ix), intger, istak(iz))
      return
      end
      subroutine mdiv (ix, iy, iz)
      common /cstak / istak(1000)
      call mpdiv (istak(ix), istak(iy), istak(iz))
      return
      end
      subroutine mdivi (ix, intger, iz)
      common /cstak / istak(1000)
      call mpdivi (istak(ix), intger, istak(iz))
      return
      end
      subroutine mmexm (ix, iy, iz)
      common /cstak / istak(1000)
      call mppwr2 (istak(ix), istak(iy), istak(iz))
      return
      end
      subroutine mmexi (ix, intger, iz)
      common /cstak / istak(1000)
      call mppwr (istak(ix), intger, istak(iz))
      return
      end
      logical function mlt (ix, iy)
      common /cstak / istak(1000)
      logical mplt
      mlt = mplt (istak(ix), istak(iy))
      return
      end
      logical function mle (ix, iy)
      common /cstak / istak(1000)
      logical mple
      mle = mple (istak(ix), istak(iy))
      return
      end
      logical function meq (ix, iy)
      common /cstak / istak(1000)
      logical mpeq
      meq = mpeq (istak(ix), istak(iy))
      return
      end
      logical function mne (ix, iy)
      common /cstak / istak(1000)
      logical mpne
      mne = mpne (istak(ix), istak(iy))
      return
      end
      logical function mge (ix, iy)
      common /cstak / istak(1000)
      logical mpge
      mge = mpge (istak(ix), istak(iy))
      return
      end
      logical function mgt (ix, iy)
      common /cstak / istak(1000)
      logical mpgt
      mgt = mpgt (istak(ix), istak(iy))
      return
      end
      subroutine mabs (ix, iz)
      common /cstak / istak(1000)
      call mpabs (istak(ix), istak(iz))
      return
      end
      subroutine mint (ix, iz)
      common /cstak / istak(1000)
      call mpcmim (istak(ix), istak(iz))
      return
      end
      subroutine mmod (ix, iy, iz)
      common /cstak / istak(1000)
      call mpmod (istak(ix), istak(iy), istak(iz))
      return
      end
      subroutine msign (ix, iy, iz)
      common /cstak / istak(1000)
      call mpsign (istak(ix), istak(iy), istak(iz))
      return
      end
      subroutine mmax1 (ix, iy, iz)
      common /cstak / istak(1000)
      call mpmax (istak(ix), istak(iy), istak(iz))
      return
      end
      subroutine mmin1 (ix, iy, iz)
      common /cstak / istak(1000)
      call mpmin (istak(ix), istak(iy), istak(iz))
      return
      end
      subroutine mdim (ix, iy, iz)
      common /cstak / istak(1000)
      call mpdim (istak(ix), istak(iy), istak(iz))
      return
      end
      subroutine mpi (intger, iz)
      common /cstak / istak(1000)
      call mppi (istak(iz))
      return
      end
      subroutine meul (intger, iz)
      common /cstak / istak(1000)
      call mpeul (istak(iz))
      return
      end
      subroutine msqrt (ix, iz)
      common /cstak / istak(1000)
      call mpsqrt (istak(ix), istak(iz))
      return
      end
      subroutine mlog (ix, iz)
      common /cstak / istak(1000)
      call mpln (istak(ix), istak(iz))
      return
      end
      subroutine mlog10 (ix, iz)
      common /cstak / istak(1000)
      call mplg10 (istak(ix), istak(iz))
      return
      end
      subroutine mexp (ix, iz)
      common /cstak / istak(1000)
      call mpexp (istak(ix), istak(iz))
      return
      end
      subroutine msin (ix, iz)
      common /cstak / istak(1000)
      call mpsin (istak(ix), istak(iz))
      return
      end
      subroutine mcos (ix, iz)
      common /cstak / istak(1000)
      call mpcos (istak(ix), istak(iz))
      return
      end
      subroutine mtan (ix, iz)
      common /cstak / istak(1000)
      call mptan (istak(ix), istak(iz))
      return
      end
      subroutine macos (ix, iz)
      common /cstak / istak(1000)
c
      call malc (ipi)
      call mpi (0, ipi)
      call mdivi (ipi, 2, ipi)
      call masin (ix, iz)
      call msub (ipi, iz, iz)
      call mdalc (ipi)
c
      return
      end
      subroutine masin (ix, iz)
      common /cstak / istak(1000)
      call mpasin (istak(ix), istak(iz))
      return
      end
      subroutine matan2 (isn, ics, iz)
      common /cstak / istak(1000)
      logical mle
c
      call malc (ipi)
      call mpi (0, ipi)
      if (istak(ics).eq.0) go to 20
c
      call malc (itmp)
      call mdiv (isn, ics, itmp)
      call matan (itmp, itmp)
c
      if (istak(ics).lt.0) call madd (itmp, ipi, itmp)
c
      if (mle(itmp, ipi)) go to 10
      call mmul1 (2, ipi, ipi)
      call msub (itmp, ipi, itmp)
c
 10   call mcopy (itmp, iz)
      call mdalc (itmp)
      call mdalc (ipi)
      return
c
 20   if (istak(isn).eq.0) call seterr (
     1  31hmatan2  both arguments are zero, 31, 1, 2)
c
      call mdivi (ipi, 2, ipi)
      call msign (ipi, isn, iz)
      call mdalc (ipi)
      return
c
      end
      subroutine matan (ix, iz)
      common /cstak / istak(1000)
      call mpatan (istak(ix), istak(iz))
      return
      end
      subroutine msinh (ix, iz)
      common /cstak / istak(1000)
      call mpsinh (istak(ix), istak(iz))
      return
      end
      subroutine mcosh (ix, iz)
      common /cstak / istak(1000)
      call mpcosh (istak(ix), istak(iz))
      return
      end
      subroutine mrec (ix, iz)
      common /cstak / istak(1000)
      call mprec (istak(ix), istak(iz))
      return
      end
      subroutine mgamma (ix, iz)
      common /cstak / istak(1000)
      call mpgam (istak(ix), istak(iz))
      return
      end
      subroutine merf (ix, iz)
      common /cstak / istak(1000)
      call mperf (istak(ix), istak(iz))
      return
      end
      subroutine merfc (ix, iz)
      common /cstak / istak(1000)
      call mperfc (istak(ix), istak(iz))
      return
      end
      subroutine mdaw (ix, iz)
      common /cstak / istak(1000)
      call mpdaw (istak(ix), istak(iz))
      return
      end
      subroutine mei (ix, iz)
      common /cstak / istak(1000)
      call mpei (istak(ix), istak(iz))
      return
      end
      subroutine mli (ix, iz)
      common /cstak / istak(1000)
      call mpli (istak(ix), istak(iz))
      return
      end
      subroutine moutf (ix, c, iwid, n)
      common /cstak / istak(1000)
      integer c(iwid)
      call mpout (istak(ix), c, iwid, n)
      return
      end
      subroutine moute (ix, c, jexp, iwid)
      common /cstak / istak(1000)
      call mpoute (istak(ix), c, jexp, iwid)
      return
      end
      subroutine meps (idum, iz)
      common /cstak / istak(1000)
      call mpeps (istak(iz))
      return
      end
      subroutine mprnt (ix, name)
      common /cstak / istak(1000)
      common /mpcom / b, t, m, lun, mxr, ipar(18)
      integer b, t, m, lun, mxr, name(2)
c
      ndig = float(t)*alog10(float(b)) + 2.5
      ic = istkgt (ndig, 2)
      call moute (ix, istak(ic), iexp, ndig)
c
      imax = ic + ndig - 1
      write (lun, 10) name, iexp, (istak(i), i=ic,imax)
 10   format (1x, a4, a2, 3x, 1h(, i6, 2h ), 3x, 5(10a1, 1x) /
     1  (25x, 5(10a1, 1x)) )
c
      call istkrl (1)
      return
      end
      subroutine mprnta (ix, n, name)
      common /cstak / istak(1000)
      common /mpcom / b, t, m, lun, mxr, ipar(18)
      integer b, t, m, lun, ix(n), name(2)
c
      ndig = float(t)*alog10(float(b)) + 2.5
      ic = istkgt (ndig, 2)
      imax = ic + ndig - 1
c
      write (lun, 10) name
 10   format (30x, a4, a2)
c
      do 30 i=1,n
        call moute (ix(i), istak(ic), iexp, ndig)
c
        write (lun, 20) i, iexp, (istak(j), j=ic, imax)
 20     format (1x, i4, 5x, 1h(, i6, 2h ), 3x, 5(10a1, 1x) /
     1    (25x, 5(10a1, 1x)) )
 30   continue
c
      call istkrl (1)
      return
      end