*
* $Id: intgrl.F,v 1.1.1.1 1996/04/01 15:03:24 mclareni Exp $
*
* $Log: intgrl.F,v $
* Revision 1.1.1.1  1996/04/01 15:03:24  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
      SUBROUTINE INTGRL (NDIM,INTDEG,NPOINT,FUNINT,ERROR)
C*NS  INTEGER NDIM, INTDEG, INTPNT
      INTEGER NDIM, INTDEG
      REAL ERROR
      COMMON /ISTRGE/ MXRGNS,ISTOR(12000)
      COMMON /RSTRGE/ RSTSZE,RSTOR(18001)
      INTEGER RSTSZE
      COMMON /BUKSZE/ MAXWRD
      INTEGER MAXWRD
      COMMON /TRESZE/ ENTREE,ENTBUC
      INTEGER ENTREE,ENTBUC
      COMMON /LIMITS/ GMINUS(10),GPLUS(10)
      COMMON /PRINT/ IPRINT
      COMMON /FUNN/ NFUN, NFOPT, NFCUT
      INTEGER NFUN, NFOPT, NFCUT
      COMMON /QUADRE/ DEGREE
      INTEGER DEGREE
      REAL UMINUS(10),UPLUS(10)
      INTEGER PARENT,PTR,NTOT,NIBUC,BUCPTR
      DOUBLE PRECISION FINT,ERRSQ
      EXTERNAL FUN
      IF(ENTBUC.GT.1) GOTO 20
      WRITE(6,10)
 10   FORMAT(' FUNINT CALLED BEFORE PARTN.')
      STOP
 20   IF(INTDEG.LE.1) GOTO 30
      IF(INTDEG.EQ.2) NFUN=NFUN+ENTBUC*(NDIM+1)
      IF(INTDEG.EQ.3) NFUN=NFUN+ENTBUC*2*NDIM
      IF(INTDEG.EQ.5) NFUN=NFUN+ENTBUC*(2*NDIM**2+1)
 30   ISCR=MXRGNS*(MAXWRD+1)
      FUNINT=0.0E+0
      ERROR=FUNINT
      BUCPTR=MXRGNS+1
      IF(INTDEG.NE.1) GOTO 50
      NTOT=NPOINT*ENTBUC
      J=BUCPTR+1
      ERRTOT=0.0E+0
      DO 40 I=1,ENTBUC
      ERRTOT=ERRTOT+SQRT(RSTOR(J))
      J=J+MAXWRD
 40   CONTINUE
 50   DO 180 IBUC=1,ENTBUC
      PARENT=1
      DO 60 J=1,NDIM
      UMINUS(J)=GMINUS(J)
      UPLUS(J)=GPLUS(J)
 60   CONTINUE
      CALL BOUNDS(IBUC,PARENT,ISTOR,RSTOR,UMINUS,UPLUS)
      IF(INTDEG.GE.0) GOTO 70
      CALL USRINT(UMINUS,UPLUS,RSTOR(BUCPTR),RSTOR(BUCPTR+1),RFINT,RERR
     1SQ)
      FUNINT=FUNINT+RFINT
      ERROR=ERROR+RERRSQ
      BUCPTR=BUCPTR+MAXWRD
      GOTO 180
 70   IF(DEGREE.NE.1) GOTO 80
      CELVOL=RSTOR(BUCPTR+6)
      GOTO 100
 80   CELVOL=1.0E+0
      DO 90 J=1,NDIM
      CELVOL=CELVOL*(UPLUS(J)-UMINUS(J))
 90   CONTINUE
 100  IF(INTDEG.LE.1) GOTO 110
      FUNINT=FUNINT+QUAD(NDIM,INTDEG,UMINUS,UPLUS,FUN)*CELVOL
      GOTO 180
 110  IF(INTDEG.NE.1) GOTO 120
      NIBUC=INT(SQRT(RSTOR(BUCPTR+1))*NTOT/ERRTOT+0.5)
      IF(NIBUC.GE.5) GOTO 130
      FUNINT=FUNINT+RSTOR(BUCPTR)
      ERROR=ERROR+RSTOR(BUCPTR+1)
      BUCPTR=BUCPTR+MAXWRD
      GOTO 180
 120  NIBUC=NPOINT
      CALL QUASI(XX,NDIM,NIBUC,-NPOINT)
 130  PTR=ISCR
      FINT=0.0E+0
      ERRSQ=FINT
      DO 170 J=1,NIBUC
      IF(INTDEG.NE.1) GOTO 140
      CALL RANUMS(RSTOR(PTR+1),NDIM)
      GOTO 150
 140  CALL QUASI(RSTOR(PTR+1),NDIM,1,NIBUC)
 150  DO 160 I=1,NDIM
      RSTOR(I+PTR)=(UPLUS(I)-UMINUS(I))*RSTOR(I+PTR)+UMINUS(I)
 160  CONTINUE
      F=FUN(NDIM,RSTOR(PTR+1))
      FINT=FINT+F
      IF(ABS(F).GT.1.0E-37) ERRSQ=ERRSQ+F**2
 170  CONTINUE
      FINT=FINT/NIBUC
      ERRSQ=ERRSQ/NIBUC
      ERRSQ=ERRSQ-FINT**2
      FINT=FINT*CELVOL
      ERRSQ=ERRSQ*CELVOL**2
      IF(INTDEG.EQ.0) ERRSQ=RSTOR(BUCPTR+1)/NIBUC
      ERRSQ=ERRSQ/NIBUC
      FUNINT=FUNINT+FINT
      ERROR=ERROR+ERRSQ
      NFUN=NFUN+NIBUC
      RSTOR(BUCPTR)=FINT
      BUCPTR=BUCPTR+MAXWRD
 180  CONTINUE
      IF(ERROR.GT.0) ERROR=SQRT(ERROR)
      IF(IPRINT.LE.0) GOTO 200
      WRITE(6,190) FUNINT,ERROR,NFUN
 190  FORMAT(' INTEGRAL ESTIMATE = ',G13.5,'   +/-',G13.5/1X,
     1 I10,' TOTAL INTEGRAND EVALUATIONS')
 200  RETURN
      END