This commit was generated by cvs2svn to compensate for changes in r2,

[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / divon / intgrl.F

diff --git a/MINICERN/mathlib/gen/divon/intgrl.F b/MINICERN/mathlib/gen/divon/intgrl.F
new file mode 100644 (file)
index 0000000..4f12bff
--- /dev/null
+++ b/MINICERN/mathlib/gen/divon/intgrl.F
@@ -0,0 +1,118 @@
+*
+* $Id$
+*
+* $Log$
+* 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