dfintnew.F

Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file dfintnew.F

*
*...CERN LIBRARY ROUTINE E104 (INTERPOLATION) :
*
      FUNCTION dfintnew(NARG,ARG,NENT,ENT,TABLE)
      IMPLICIT DOUBLE PRECISION (a-h,o-z)
      dimension arg(5),nent(5),ent(73),table(1200)
      dimension d(5),ncomb(5),ient(5)
      kd=1
      m=1
      ja=1
         DO 5 i=1,narg
      ncomb(i)=1
      jb=ja-1+nent(i)
         DO 2 j=ja,jb
      IF (arg(i).LE.ent(j)) go to 3
    2 CONTINUE
      j=jb
    3 IF (j.NE.ja) go to 4
      j=j+1
    4 jr=j-1
      d(i)=(ent(j)-arg(i))/(ent(j)-ent(jr))
      ient(i)=j-ja
      kd=kd+ient(i)*m
      m=m*nent(i)
    5 ja=jb+1
      dfintnew=0.d0
   10 fac=1.d0
      iadr=kd
      ifadr=1
         DO 15 i=1,narg
      IF (ncomb(i).EQ.0) go to 12
      fac=fac*(1.d0-d(i))
      go to 15
   12 fac=fac*d(i)
      iadr=iadr-ifadr
   15 ifadr=ifadr*nent(i)
      dfintnew=dfintnew+fac*table(iadr)
      il=narg
   40 IF (ncomb(il).EQ.0) go to 80
      ncomb(il)=0
      IF (il.EQ.narg) go to 10
      il=il+1
         DO 50  k=il,narg
   50 ncomb(k)=1
      go to 10
   80 il=il-1
      IF(il.NE.0) go to 40
      RETURN
      END