      SUBROUTINE QUADSR(NLV,NLP1V,NLP2V,P,PD)
      implicit real(selected_real_kind(15)) (a-h,o-z)
      COMMON/INPUT/P1,P2,TRNSLO,IA,JA,N
      common / output / trns(200,200)
      DIMENSION P(NLP1V),PD(NLP2V)
      DIMENSION WT(101)
      N2=2*N
      N2P=2*N+1
C  *****WEIGHTS ARE CALCULATED
      WT(1)=1.
      DO 21 I=1,N
      WT(2*I)=4.
      WT(2*I+1)=1.
21    CONTINUE
      IF (N.EQ.1) GO TO 25
      DO 22 I=2,N
      WT(2*I-1)=2.
22    CONTINUE
25    CONTINUE
      TRNSNB=0.
      DP=(PD(IA)-PD(IA-1))/N2
      PFIX=P(JA)
      DO 1 KK=1,N2P
      PVARY=PD(IA-1)+(KK-1)*DP
      IF (PVARY.GE.PFIX) P2=PVARY
      IF (PVARY.GE.PFIX) P1=PFIX
      IF (PVARY.LT.PFIX) P1=PVARY
      IF (PVARY.LT.PFIX) P2=PFIX
      CALL SINTR2
      TRNSNB=TRNSNB+TRNSLO*WT(KK)
1     CONTINUE
      TRNS(IA,JA)=TRNSNB*DP/(3.*(PD(IA)-PD(IA-1)))
      RETURN
      END
