      SUBROUTINE qgaus1(func,a,b,ss,q) ! one parameter
      REAL*8 a,b,ss,func,q 
      EXTERNAL func
      INTEGER j
      REAL*8 dx,xm,xr,w(5),x(5)
      SAVE w,x
      DATA w/.2955242247d0,.2692667193d0,.2190863625d0,.1494513491d0,
     *.0666713443d0/
      DATA x/.1488743389d0,.4333953941d0,.6794095682d0,.8650633666d0,
     *.9739065285d0/
      xm=0.5d0*(b+a)
      xr=0.5d0*(b-a)
      ss=0d0
      do 11 j=1,5
        dx=xr*x(j)
        ss=ss+w(j)*(func(xm+dx,q)+func(xm-dx,q))
11    continue
      ss=xr*ss

      return
      END

C     (C) Copr. 1986-92 Numerical Recipes Software D041&0(9p#3.
