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
.
