perinola.F

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

*72*********************************************************************
      DOUBLE PRECISION FUNCTION perinola(ARG,TABLE)
       IMPLICIT NONE

      
      common/ xarray / ent
      DOUBLE PRECISION ent(102)
      
      INTEGER nent(2),ncomb(7),ient(7),narg,kd,m,ja,i,jb,j,jr,iadr,ifadr
      INTEGER il,k
      DOUBLE PRECISION arg(2),table(*),d(7),fac

      narg=2
      nent(1)=76
      nent(2)=26
      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
      perinola=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)
      perinola=perinola+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