SUBROUTINE SINTR2
      implicit real(selected_real_kind(15)) (a-h,o-z)
      REAL(selected_real_kind(15)) :: P1,P2,PA,TRNSLO,TRANSA
      COMMON/INPUT/P1,P2,TRNSLO,IA,JA,N
      COMMON/PRESS/ PA(109)
      COMMON/TRAN/ TRANSA(109,109)
      COMMON/COEFS/XA(109),CA(109),ETA(109),SEXPV(109),CORE,UEXP,SEXP
c---find indices for pa corresponding to p1 and p2 (to use for 
c   pressure interpolation
      if (p2.le.pa(1)) then
         i=1
      endif
      do 70 k=1,108
        if (p2.gt.pa(k).and.p2.le.pa(k+1)) then
           i=k
        endif
70    continue
      if (p2.gt.pa(109)) then
        i=108
      endif
      if (p1.le.pa(1)) then
         j=1
      endif
      do 80 k=1,108
        if (p1.gt.pa(k).and.p1.le.pa(k+1)) then
           j=k
        endif
80    continue
      if (p1.gt.pa(109)) then
        j=108
      endif
c--define double prec. quantities for pressures used in calc.
      p1d=p1
      p2d=p2
      padi=pa(i)
      padip=pa(i+1)
      padj=pa(j)
      padjp=pa(j+1)
      if (i.lt.108) padip2=pa(i+2)
      if (j.lt.108) padjp2=pa(j+2)
C  DETERMINE ETAP,THE VALUE OF ETA TO USE BY LINEAR INTERPOLATION
C    FOR PETA(=0.5*(P1+P2))
      PETA=p2d 
c---if peta=p2d,ieta will equal i
      ieta=i
      paieta=pa(ieta)
      paiet1=pa(ieta+1)
      ETAP=ETA(IETA)+(p2d-paieta)*(ETA(ieta+1)-ETA(IETA))/
     1 (paiet1-paieta)
      SEXP=SEXPV(IETA)+(p2d-paieta)*(SEXPV(ieta+1)-
     1 SEXPV(IETA))/(paiet1-paieta)
      PIPMPI=padip-padi
      UP2P1=(PATH(p2d,p1d,CORE,ETAP))**UEXP
      suexp=sexp/uexp
      if (i.le.j) then
        TRIP=(CA(i+1)*DLOG(1.0D0+XA(i+1)*UP2P1))**suexp
        TRI=(CA(I)*DLOG(1.0D0+XA(I)*UP2P1))**suexp
        TRNSLO=1.0D0-((padip-p2d)*TRI+(p2d-padi)*TRIP)/PIPMPI
      endif
      if (i.gt.j) then
      TIJ=TRANSA(I,J)
      TIPJ=TRANSA(I+1,J)
      TIJP=TRANSA(I,J+1)
      TIPJP=TRANSA(I+1,J+1)
      UIJ=(PATH(padi,padj,CORE,ETAP))**UEXP
      UIPJ=(PATH(padip,padj,CORE,ETAP))**UEXP
      UIJP=(PATH(padi,padjp,CORE,ETAP))**UEXP
      UIPJP=(PATH(padip,padjp,CORE,ETAP))**UEXP
      PRODI=CA(I)*XA(I)
      PRODIP=CA(I+1)*XA(I+1)
      PROD=((padip-p2d)*PRODI+(p2d-padi)*PRODIP)/PIPMPI
      XINT=((padip-p2d)*XA(I)+(p2d-padi)*XA(I+1))/PIPMPI
      CINT=PROD/XINT
      AIJ=(CINT*DLOG(1.0D0+XINT*UIJ))**suexp
      AIJP=(CINT*DLOG(1.0D0+XINT*UIJP))**suexp
      AIPJ=(CINT*DLOG(1.0D0+XINT*UIPJ))**suexp
      AIPJP=(CINT*DLOG(1.0D0+XINT*UIPJP))**suexp
      EIJ=TIJ+AIJ
      EIPJ=TIPJ+AIPJ
      EIJP=TIJP+AIJP
      EIPJP=TIPJP+AIPJP
      DTDJ=(EIJP-EIJ)/(padjp-padj)
      DTDPJ=(EIPJP-EIPJ)/(padjp-padj)
      EPIP1=EIJ+DTDJ*(p1d-padj)
      EPIPP1=EIPJ+DTDPJ*(p1d-padj)
      EPP2P1=((padip-p2d)*EPIP1+(p2d-padi)*EPIPP1)/PIPMPI
      TRNSLO=EPP2P1-(CINT*DLOG(1.0D0+XINT*UP2P1))**suexp
      endif
      if (i.lt.108.and.j.lt.108.and.i.gt.j+2) then
      TIP2J=TRANSA(I+2,J)
      TIP2JP=TRANSA(I+2,J+1)
      TI2J2=TRANSA(I+2,J+2)
      TIJP2=TRANSA(I,J+2)
      TIPJP2=TRANSA(I+1,J+2)
      UIP2J=(PATH(padip2,padj,CORE,ETAP))**UEXP
      UIJP2=(PATH(padi,padjp2,CORE,ETAP))**UEXP
      UIPJP2=(PATH(padip,padjp2,CORE,ETAP))**UEXP
      UI2J2=(PATH(padip2,padjp2,CORE,ETAP))**UEXP
      UIP2JP=(PATH(padip2,padjp,CORE,ETAP))**UEXP
      AIJP2=(CINT*DLOG(1.0D0+XINT*UIJP2))**suexp
      AIPJP2=(CINT*DLOG(1.0D0+XINT*UIPJP2))**suexp
      AIP2J=(CINT*DLOG(1.0D0+XINT*UIP2J))**suexp
      AIP2JP=(CINT*DLOG(1.0D0+XINT*UIP2JP))**suexp
      AI2J2=(CINT*DLOG(1.0D0+XINT*UI2J2))**suexp
      EIP2J=TIP2J+AIP2J
      EIP2JP=TIP2JP+AIP2JP
      EIJP2=TIJP2+AIJP2
      EIPJP2=TIPJP2+AIPJP2
      EI2J2=TI2J2+AI2J2
      CALL QINTRP(padj,padjp,padjp2,EIJ,EIJP,EIJP2,p1d,EI)
      CALL QINTRP(padj,padjp,padjp2,EIPJ,EIPJP,EIPJP2,p1d,EP)
      CALL QINTRP(padj,padjp,padjp2,EIP2J,EIP2JP,EI2J2,p1d,EP2)
      CALL QINTRP(padi,padip,padip2,EI,EP,EP2,p2d,EPSIL)
      TRNSLO=EPSIL-(CINT*DLOG(1.0D0+XINT*UP2P1))**suexp
      endif
      RETURN
      END