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 30003 call malc (mtmp(o0i1)) 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) 30001 continue if (.not. (iopt.eq.3)) go to 30002 call meps (0,mtmp(1)) call mdivi (mtmp(1),b,mres) 30002 continue if (iopt.eq.4) call meps (0,mres) c go to 30000 c ----- return code ----- 30000 continue call mcopy (mres,mrlt) c ----- begin erasure ----- call mdalc (mres) do 30004 o0i1 = 1, 2 30004 call mdalc (mtmp(o0i1)) call mdalc (btmp) c ----- end erasure ----- return end