subroutine mccopy (x, z)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
c                     multiple precision
      integer x(2), z(2)
c               ===== translated program =====
      call mcopy (x(1),z(1))
      call mcopy (x(2),z(2))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mcalc (ix)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
      integer ix(2)
c               ===== translated program =====
      call malc (ix(1))
      call malc (ix(2))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mcdalc (ix)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
      integer ix(2)
c               ===== translated program =====
      call mdalc (ix(2))
      call mdalc (ix(1))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mcadd (x, y, z)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
c                     multiple precision
      integer x(2), y(2), z(2)
c               ===== translated program =====
      call madd (x(1),y(1),z(1))
      call madd (x(2),y(2),z(2))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mcsub (x, y, z)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
c                     multiple precision
      integer x(2), y(2), z(2)
c               ===== translated program =====
      call msub (x(1),y(1),z(1))
      call msub (x(2),y(2),z(2))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mcmul1 (intger, y, z)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
      integer intger
c                     multiple precision
      integer y(2), z(2)
c               ===== translated program =====
      call mmul1 (intger,y(1),z(1))
      call mmul1 (intger,y(2),z(2))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mcmul2 (x, intger, z)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
      integer intger
c                     multiple precision
      integer x(2), z(2)
c               ===== translated program =====
      call mmul1 (intger,x(1),z(1))
      call mmul1 (intger,x(2),z(2))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mcmul (x, y, z)
c               ===== processed by augment, version 4n =====
c               ----- initialize/erase indexes -----
      integer o0i1
c               ----- temporary storage locations -----
c                     multiple precision
      integer mtmp(2)
c               ----- local variables -----
c                     multiple precision
      integer tmp
c               ----- global variables -----
c                     multiple precision
      integer x(2), y(2), z(2)
c               ===== translated program =====
c               ----- begin initialization -----
      do 30001  o0i1 = 1, 2
30001 call malc (mtmp(o0i1))
      call malc (tmp)
c               ----- end initialization -----
      call mmul (x(1),y(1),mtmp(1))
      call mmul (x(2),y(2),mtmp(2))
      call msub (mtmp(1),mtmp(2),tmp)
      call mmul (x(1),y(2),mtmp(1))
      call mmul (x(2),y(1),mtmp(2))
      call madd (mtmp(1),mtmp(2),z(2))
      call mcopy (tmp,z(1))
      go to 30000
c               ----- return code -----
30000 continue
c               ----- begin erasure -----
      do 30002  o0i1 = 1, 2
30002 call mdalc (mtmp(o0i1))
      call mdalc (tmp)
c               ----- end erasure -----
      return
      end
      subroutine mcdiv (x, y, z)
c               ===== processed by augment, version 4n =====
c               ----- initialize/erase indexes -----
      integer o0i1
c               ----- temporary storage locations -----
c                     multiple precision
      integer mtmp(2)
c               ----- local variables -----
c                     multiple precision
      integer tmp1, tmp2
c               ----- global variables -----
c                     multiple precision
      integer x(2), y(2), z(2)
c               ----- functions -----
      real rec
c               ===== translated program =====
c               ----- begin initialization -----
      do 30001  o0i1 = 1, 2
30001 call malc (mtmp(o0i1))
      call malc (tmp1)
      call malc (tmp2)
c               ----- end initialization -----
      call mmul (y(1),y(1),mtmp(1))
      call mmul (y(2),y(2),mtmp(2))
      call madd (mtmp(1),mtmp(2),mtmp(2))
      call metom (rec (mtmp(2)),tmp1)
      call mmul (x(1),y(1),mtmp(1))
      call mmul (x(2),y(2),mtmp(2))
      call madd (mtmp(1),mtmp(2),mtmp(2))
      call mmul (mtmp(2),tmp1,tmp2)
      call mmul (x(1),y(2),mtmp(1))
      call mneg (mtmp(1),mtmp(1))
      call mmul (x(2),y(1),mtmp(2))
      call madd (mtmp(1),mtmp(2),mtmp(2))
      call mmul (mtmp(2),tmp1,z(2))
      call mcopy (tmp2,z(1))
      go to 30000
c               ----- return code -----
30000 continue
c               ----- begin erasure -----
      do 30002  o0i1 = 1, 2
30002 call mdalc (mtmp(o0i1))
      call mdalc (tmp1)
      call mdalc (tmp2)
c               ----- end erasure -----
      return
      end
      subroutine mcdivi (x, intger, z)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
      integer intger
c                     multiple precision
      integer x(2), z(2)
c               ===== translated program =====
      call mdivi (x(1),intger,z(1))
      call mdivi (x(2),intger,z(2))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mccexi (x,n, mcrlt)
c               ===== processed by augment, version 4n =====
c               ----- temporary storage locations -----
c                     multiple complex
      integer mctmp(2,1)
c               ----- local variables -----
      integer n2, ns
c                     multiple complex
      integer sq(2), mcres(2)
c               ----- global variables -----
      integer n
c                     multiple complex
      integer x(2), mcrlt(2)
c               ----- supporting package functions -----
      logical mcne
c               ===== translated program =====
c
c               ----- begin initialization -----
      call mcalc (mcres)
      call mcalc (mctmp(1,1))
      call mcalc (sq)
c               ----- end initialization -----
      n2 = n
      if (n2) 20, 10, 40
c
 10   call mcitoc (1,mcres)
      go to 30000
c
 20   n2 = -n2
c ===== mixed mode operands accepted =====
      call mcitoc (0,mctmp(1,1))
      if (mcne (x,mctmp(1,1)))  go to 60
      call seterr (30hmccexi  zero to negative power, 30, 1, 2)
      stop
c
c ===== mixed mode operands accepted =====
 40   call mcitoc (0,mctmp(1,1))
      if (mcne (x,mctmp(1,1)))  go to 60
      call mcitoc (0,mcres)
      go to 30000
c
 60   call mccopy (x,sq)
c ===== mixed mode operands accepted =====
      if (.not. (n.lt.0)) go to 30001
      call mcitoc (1,mctmp(1,1))
      call mcdiv (mctmp(1,1),sq,sq)
30001 continue
      call mcitoc (1,mcres)
c
 70   ns = n2
      n2 = n2/2
      if (2*n2.ne.ns) call mcmul (sq,mcres,mcres)
      if (n2.le.0) go to 30000
      call mcmul (sq,sq,sq)
      go to 70
c
c               ----- return code -----
30000 continue
      call mccopy (mcres,mcrlt)
c               ----- begin erasure -----
      call mcdalc (mcres)
      call mcdalc (mctmp(1,1))
      call mcdalc (sq)
c               ----- end erasure -----
      return
      end
      subroutine mccexc (x,y, mcrlt)
c               ===== processed by augment, version 4n =====
c               ----- temporary storage locations -----
c                     multiple complex
      integer mctmp(2,1)
c               ----- local variables -----
c                     multiple complex
      integer mcres(2)
c               ----- global variables -----
c                     multiple complex
      integer x(2), y(2), mcrlt(2)
c               ----- supporting package functions -----
      logical mcne
c               ===== translated program =====
c
c               ----- begin initialization -----
      call mcalc (mcres)
      call mcalc (mctmp(1,1))
c               ----- end initialization -----
c ===== mixed mode operands accepted =====
      call mcetoc (0.,mctmp(1,1))
      if (mcne (y,mctmp(1,1)))  go to 10
      call mcitoc (1,mcres)
      go to 30000
c
c ===== mixed mode operands accepted =====
 10   call mcetoc (0.,mctmp(1,1))
      if (mcne (x,mctmp(1,1)))  go to 20
      call mcitoc (0,mcres)
      go to 30000
c
 20   call mclog (x,mctmp(1,1))
      call mcmul (y,mctmp(1,1),mctmp(1,1))
      call mcexp (mctmp(1,1),mcres)
      go to 30000
c
c               ----- return code -----
30000 continue
      call mccopy (mcres,mcrlt)
c               ----- begin erasure -----
      call mcdalc (mcres)
      call mcdalc (mctmp(1,1))
c               ----- end erasure -----
      return
      end
      subroutine mcitoc (intger, z)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
      integer intger
c                     multiple precision
      integer z(2)
c               ===== translated program =====
      call mitom (intger,z(1))
      call mitom (0,z(2))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mcetoc (r, z)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
      real r
c                     multiple precision
      integer z(2)
c               ===== translated program =====
      call metom (r,z(1))
      call mitom (0,z(2))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mcdtoc (d, z)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
      double precision d
c                     multiple precision
      integer z(2)
c               ===== translated program =====
      call mdtom (d,z(1))
      call mitom (0,z(2))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mcctoc (c, z)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
      complex c
c                     multiple precision
      integer z(1)
c               ===== translated program =====
      call metom (real (c),z(1))
      call metom (aimag (c),z(2))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      logical function mceq (x,y)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
c                     multiple precision
      integer x(2), y(2)
c               ----- functions -----
      logical mne
c               ===== translated program =====
c
      mceq = .false.
      if (mne(x(1),y(1))) go to 30000
      if (mne(x(2),y(2))) go to 30000
      mceq = .true.
c
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      logical function mcne (x,y)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
c                     multiple precision
      integer x(2), y(2)
c               ----- functions -----
      logical meq
c               ===== translated program =====
c
      mcne = .false.
      if (meq(x(1),y(1))) go to 30000
      if (meq(x(2),y(2))) go to 30000
      mcne = .true.
c
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mcreal (z, mrlt)
c               ===== processed by augment, version 4n =====
c               ----- local variables -----
c                     multiple precision
      integer mres
c               ----- global variables -----
c                     multiple precision
      integer z(2), mrlt
c               ===== translated program =====
c               ----- begin initialization -----
      call malc (mres)
c               ----- end initialization -----
      call mcopy (z(1),mres)
      go to 30000
c               ----- return code -----
30000 continue
      call mcopy (mres,mrlt)
c               ----- begin erasure -----
      call mdalc (mres)
c               ----- end erasure -----
      return
      end
      subroutine mcimag (z, mrlt)
c               ===== processed by augment, version 4n =====
c               ----- local variables -----
c                     multiple precision
      integer mres
c               ----- global variables -----
c                     multiple precision
      integer z(2), mrlt
c               ===== translated program =====
c               ----- begin initialization -----
      call malc (mres)
c               ----- end initialization -----
      call mcopy (z(2),mres)
      go to 30000
c               ----- return code -----
30000 continue
      call mcopy (mres,mrlt)
c               ----- begin erasure -----
      call mdalc (mres)
c               ----- end erasure -----
      return
      end
      subroutine mccmpl (x, y, z)
c               ===== processed by augment, version 4n =====
c               ----- global variables -----
c                     multiple precision
      integer x, y, z(2)
c               ===== translated program =====
      call mcopy (x,z(1))
      call mcopy (y,z(2))
      go to 30000
c               ----- return code -----
30000 continue
      return
      end
      subroutine mcexp (z, mcrlt)
c               ===== processed by augment, version 4n =====
c               ----- initialize/erase indexes -----
      integer o0i1
c               ----- temporary storage locations -----
c                     multiple precision
      integer mtmp(2)
c               ----- local variables -----
c                     multiple precision
      integer r, y
c                     multiple complex
      integer mcres(2)
c               ----- global variables -----
c                     multiple complex
      integer z(2), mcrlt(2)
c               ----- supporting package functions -----
      logical meq
c               ===== translated program =====
c
c               ----- begin initialization -----
      call mcalc (mcres)
      do 30001  o0i1 = 1, 2
30001 call malc (mtmp(o0i1))
      call malc (r)
      call malc (y)
c               ----- end initialization -----
      call mcreal (z,mtmp(1))
      call mexp (mtmp(1),r)
c ===== mixed mode operands accepted =====
      call mitom (0,mtmp(1))
      if (meq (r,mtmp(1)))  go to 10
c
      call mcimag (z,y)
      call mcos (y,mtmp(1))
      call mmul (r,mtmp(1),mtmp(1))
      call msin (y,mtmp(2))
      call mmul (r,mtmp(2),mtmp(2))
      call mccmpl (mtmp(1),mtmp(2),mcres)
      go to 30000
c
 10   call mcitoc (0,mcres)
      go to 30000
c
c               ----- return code -----
30000 continue
      call mccopy (mcres,mcrlt)
c               ----- begin erasure -----
      call mcdalc (mcres)
      do 30002  o0i1 = 1, 2
30002 call mdalc (mtmp(o0i1))
      call mdalc (r)
      call mdalc (y)
c               ----- end erasure -----
      return
      end
      subroutine mclog (z, mcrlt)
c               ===== processed by augment, version 4n =====
c               ----- initialize/erase indexes -----
      integer o0i1
c               ----- temporary storage locations -----
c                     multiple precision
      integer mtmp(2)
c               ----- local variables -----
c                     multiple complex
      integer mcres(2)
c               ----- global variables -----
c                     multiple complex
      integer z(2), mcrlt(2)
c               ===== translated program =====
c
c               ----- begin initialization -----
      call mcalc (mcres)
      do 30001  o0i1 = 1, 2
30001 call malc (mtmp(o0i1))
c               ----- end initialization -----
      call mcabs (z,mtmp(1))
      call mlog (mtmp(1),mtmp(1))
      call mcarg (z,mtmp(2))
      call mccmpl (mtmp(1),mtmp(2),mcres)
c
      go to 30000
c               ----- return code -----
30000 continue
      call mccopy (mcres,mcrlt)
c               ----- begin erasure -----
      call mcdalc (mcres)
      do 30002  o0i1 = 1, 2
30002 call mdalc (mtmp(o0i1))
c               ----- end erasure -----
      return
      end
      subroutine mcabs (z, mrlt)
c               ===== processed by augment, version 4n =====
c               ----- initialize/erase indexes -----
      integer o0i1
c               ----- temporary storage locations -----
c                     multiple precision
      integer mtmp(2)
c               ----- local variables -----
c                     multiple precision
      integer r1, r2, x, y, mres
c               ----- global variables -----
c                     multiple precision
      integer mrlt
c                     multiple complex
      integer z(2)
c               ----- supporting package functions -----
      logical mne
c               ===== translated program =====
c
c               ----- begin initialization -----
      call malc (mres)
      do 30002  o0i1 = 1, 2
30002 call malc (mtmp(o0i1))
      call malc (r1)
      call malc (r2)
      call malc (x)
      call malc (y)
c               ----- end initialization -----
      call mcreal (z,mtmp(1))
      call mabs (mtmp(1),x)
      call mcimag (z,mtmp(1))
      call mabs (mtmp(1),y)
      call mmin1 (x,y,r1)
      call mmax1 (x,y,r2)
c
      call mcopy (r2,mres)
c ===== mixed mode operands accepted =====
c ===== mixed mode operands accepted =====
      call mdtom (0.d0,mtmp(1))
      if (.not. (mne (r1,mtmp(1)))) go to 30001
      call mdiv (r1,r2,mtmp(1))
      call mmexi (mtmp(1),2,mtmp(1))
      call mdtom (1.d0,mtmp(2))
      call madd (mtmp(2),mtmp(1),mtmp(1))
      call msqrt (mtmp(1),mtmp(1))
      call mmul (r2,mtmp(1),mres)
30001 continue
c
      go to 30000
c               ----- return code -----
30000 continue
      call mcopy (mres,mrlt)
c               ----- begin erasure -----
      call mdalc (mres)
      do 30003  o0i1 = 1, 2
30003 call mdalc (mtmp(o0i1))
      call mdalc (r1)
      call mdalc (r2)
      call mdalc (x)
      call mdalc (y)
c               ----- end erasure -----
      return
      end
      subroutine mcarg (z, mrlt)
c               ===== processed by augment, version 4n =====
c               ----- initialize/erase indexes -----
      integer o0i1
c               ----- temporary storage locations -----
c                     multiple precision
      integer mtmp(2)
c               ----- local variables -----
c                     multiple precision
      integer mres
c               ----- global variables -----
c                     multiple precision
      integer mrlt
c                     multiple complex
      integer z(2)
c               ----- supporting package functions -----
      logical meq, mne
c               ===== translated program =====
c
c               ----- begin initialization -----
      call malc (mres)
      do 30001  o0i1 = 1, 2
30001 call malc (mtmp(o0i1))
c               ----- end initialization -----
      call mitom (0,mres)
c ===== mixed mode operands accepted =====
      call mcreal (z,mtmp(1))
      call mitom (0,mtmp(2))
      if (mne (mtmp(1),mtmp(2)))  go to 10
c ===== mixed mode operands accepted =====
      call mcimag (z,mtmp(1))
      call mitom (0,mtmp(2))
      if (meq (mtmp(1),mtmp(2))) go to 30000
c
 10   call mcimag (z,mtmp(1))
      call mcreal (z,mtmp(2))
      call matan2 (mtmp(1),mtmp(2),mres)
c
      go to 30000
c               ----- return code -----
30000 continue
      call mcopy (mres,mrlt)
c               ----- begin erasure -----
      call mdalc (mres)
      do 30002  o0i1 = 1, 2
30002 call mdalc (mtmp(o0i1))
c               ----- end erasure -----
      return
      end
      subroutine mcsqrt (z, mcrlt)
c               ===== processed by augment, version 4n =====
c               ----- initialize/erase indexes -----
      integer o0i1
c               ----- temporary storage locations -----
c                     multiple precision
      integer mtmp(2)
c               ----- local variables -----
c                     multiple precision
      integer r, x, xtmp, y, ytmp
c                     multiple complex
      integer mcres(2)
c               ----- global variables -----
c                     multiple complex
      integer z(2), mcrlt(2)
c               ----- supporting package functions -----
      logical mlt, meq, mge, mne
c               ===== translated program =====
c
c               ----- begin initialization -----
      call mcalc (mcres)
      do 30002  o0i1 = 1, 2
30002 call malc (mtmp(o0i1))
      call malc (r)
      call malc (x)
      call malc (xtmp)
      call malc (y)
      call malc (ytmp)
c               ----- end initialization -----
      call mcreal (z,x)
      call mcimag (z,y)
      call mcabs (z,r)
c
c ===== mixed mode operands accepted =====
      call mitom (0,mtmp(1))
      if (mne (r,mtmp(1)))  go to 10
      call mcitoc (0,mcres)
      go to 30000
c
 10   call mabs (x,mtmp(1))
      call madd (r,mtmp(1),mtmp(1))
      call mdivi (mtmp(1),2,mtmp(1))
      call msqrt (mtmp(1),xtmp)
      call mmul1 (2,xtmp,mtmp(1))
      call mdiv (y,mtmp(1),ytmp)
c
c ===== mixed mode operands accepted =====
      call mitom (0,mtmp(1))
      if (mge (x,mtmp(1))) call mccmpl (xtmp,ytmp,mcres)
c ===== mixed mode operands accepted =====
      call mitom (0,mtmp(1))
      if (meq (y,mtmp(1))) call mitom (1,y)
c ===== mixed mode operands accepted =====
      call mitom (0,mtmp(1))
      if (.not. (mlt (x,mtmp(1)))) go to 30001
      call mabs (ytmp,mtmp(1))
      call msign (xtmp,y,mtmp(2))
      call mccmpl (mtmp(1),mtmp(2),mcres)
30001 continue
c
      go to 30000
c               ----- return code -----
30000 continue
      call mccopy (mcres,mcrlt)
c               ----- begin erasure -----
      call mcdalc (mcres)
      do 30003  o0i1 = 1, 2
30003 call mdalc (mtmp(o0i1))
      call mdalc (r)
      call mdalc (x)
      call mdalc (xtmp)
      call mdalc (y)
      call mdalc (ytmp)
c               ----- end erasure -----
      return
      end

.