[CONTACT]

[ABOUT]

[POLICY]

processed by version erase indexes

Found at: ftp.icm.edu.pl:70/packages/netlib/bmp/msupport2.f

      subroutine m1mach (iopt, 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 btmp, mres
c               ----- global variables -----
      integer b, iopt, ipar(18), lun, m, mxr, t
c                     multiple precision
      integer mrlt
c               ----- common blocks -----
      common /mpcom/ b, t, m, lun, mxr, ipar
c               ===== translated program =====
c
c               ----- begin initialization -----
      call malc (mres)
      do 30003  o0i1 = 1, 2
      call malc (btmp)
c               ----- end initialization -----
      if (iopt.lt.1 .or. iopt.gt.4)  call seterr (
     *   25hm1mach  iopt lt 1 or gt 4, 25, 1, 2)
c
      call mitom (b,btmp)
      if (iopt.eq.1) call mmexi (btmp,(-m),mres)
c ===== mixed mode operands accepted =====
      if (.not. (iopt.eq.2)) go to 30001
      call mmexi (btmp,(m-1),mtmp(1))
      call mdtom (.999d0,mtmp(2))
      call mmul (mtmp(2),btmp,mtmp(2))
      call mmul (mtmp(1),mtmp(2),mres)
      if (.not. (iopt.eq.3)) go to 30002
      call meps (0,mtmp(1))
      call mdivi (mtmp(1),b,mres)
      if (iopt.eq.4) call meps (0,mres)
c
      go to 30000
c               ----- return code -----
      call mcopy (mres,mrlt)
c               ----- begin erasure -----
      call mdalc (mres)
      do 30004  o0i1 = 1, 2
      call mdalc (btmp)
c               ----- end erasure -----
      return
      end

.


AD:

NEW PAGES:

[ODDNUGGET]

[GOPHER]