Prev Next dint.f Headings

dint.f
       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


Input File: f.omh/dint.f.omh