double precision function dint (x)
c***begin prologue dint
c***revision october 1, 1980
c***category no. m2
c***keyword(s) truncation,greatest integer,double precision
c***author fullerton w. (lasl)
c***date written august 1979
c***purpose to find the largest integer whose magnitude does
c not exceed x and convert to double precision.
c***description
c august 1979 edition. w. fullerton, los alamos scientific laboratory.
c installed on the vax by dolores montano, c-3, 5/80.
c
c dint is the double precision equivalent of aint. this portable
c version is quite efficient when the argument is reasonably small (a
c common case), and so no faster machine-dependent version is needed.
c
c
c***reference(s)
c***routines called d1mach,i1mach,r1mach,xerror
c***end prologue
double precision x,xscl,scale,xbig,xmax,part,d1mach
data npart,scale,xbig,xmax /0, 3*0.0d0 /
c***first executable statement dint
if(npart.ne.0) go to 10
ibase = i1mach(7)
ndigd = i1mach(14)
ndigi = min0(i1mach(8),i1mach(11)) - 1
nmax = 1.0d0/d1mach(4)
xbig = amin1 (float(i1mach(9)),1.0/r1mach(4))
if (ibase.ne.i1mach(10)) call xerror (
1 'dint algorithm error. integer base ne real base', 49, 2, 2)
c
npart = (ndigd + ndigi -1) / ndigi
scale = ibase**ndigi
c
10 if(x.lt.(-xbig) .or. x.gt.xbig) go to 20
c
dint=int(sngl(x))
return
c
20 xscl = dabs(x)
if(xscl.gt.xmax) go to 50
c
do 30 i=1,npart
xscl=xscl/scale
30 continue
c
do 40 i=1,npart
xscl = xscl*scale
ipart=xscl
part=ipart
xscl=xscl - part
dint = dint * scale + part
40 continue
c
if(x.lt.0.0d0) dint = -dint
return
c
50 call xerror ('dint dabs(x) may be too big to be represented
1as an exact integer', 67, 1, 1)
dint=x
return
c
end