dfint.F

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

*72*********************************************************************
*     
*...CERN LIBRARY ROUTINE E104 (INTERPOLATION) :
*
      FUNCTION dfint(NARG,ARG,NENT,ENT,TABLE)
c     IMPLICIT DOUBLE PRECISION (A-H,O-Z)
cerw
c     IMPLICIT INTEGER (I-N)
cerw
cywu>>
      DOUBLE PRECISION fac,d,ent,arg,dfint,table
      integer iadr,ifadr,j,jr,ncomb,ient,il,k,jb,nent,narg,
     &        ja,i,m,kd
cywu<<
  
      dimension arg(5),nent(5),ent(63),table(882)
      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
      dfint=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)
      dfint=dfint+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