This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / divon / intgrl.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:03:24  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10       SUBROUTINE INTGRL (NDIM,INTDEG,NPOINT,FUNINT,ERROR)
11 C*NS  INTEGER NDIM, INTDEG, INTPNT
12       INTEGER NDIM, INTDEG
13       REAL ERROR
14       COMMON /ISTRGE/ MXRGNS,ISTOR(12000)
15       COMMON /RSTRGE/ RSTSZE,RSTOR(18001)
16       INTEGER RSTSZE
17       COMMON /BUKSZE/ MAXWRD
18       INTEGER MAXWRD
19       COMMON /TRESZE/ ENTREE,ENTBUC
20       INTEGER ENTREE,ENTBUC
21       COMMON /LIMITS/ GMINUS(10),GPLUS(10)
22       COMMON /PRINT/ IPRINT
23       COMMON /FUNN/ NFUN, NFOPT, NFCUT
24       INTEGER NFUN, NFOPT, NFCUT
25       COMMON /QUADRE/ DEGREE
26       INTEGER DEGREE
27       REAL UMINUS(10),UPLUS(10)
28       INTEGER PARENT,PTR,NTOT,NIBUC,BUCPTR
29       DOUBLE PRECISION FINT,ERRSQ
30       EXTERNAL FUN
31       IF(ENTBUC.GT.1) GOTO 20
32       WRITE(6,10)
33  10   FORMAT(' FUNINT CALLED BEFORE PARTN.')
34       STOP
35  20   IF(INTDEG.LE.1) GOTO 30
36       IF(INTDEG.EQ.2) NFUN=NFUN+ENTBUC*(NDIM+1)
37       IF(INTDEG.EQ.3) NFUN=NFUN+ENTBUC*2*NDIM
38       IF(INTDEG.EQ.5) NFUN=NFUN+ENTBUC*(2*NDIM**2+1)
39  30   ISCR=MXRGNS*(MAXWRD+1)
40       FUNINT=0.0E+0
41       ERROR=FUNINT
42       BUCPTR=MXRGNS+1
43       IF(INTDEG.NE.1) GOTO 50
44       NTOT=NPOINT*ENTBUC
45       J=BUCPTR+1
46       ERRTOT=0.0E+0
47       DO 40 I=1,ENTBUC
48       ERRTOT=ERRTOT+SQRT(RSTOR(J))
49       J=J+MAXWRD
50  40   CONTINUE
51  50   DO 180 IBUC=1,ENTBUC
52       PARENT=1
53       DO 60 J=1,NDIM
54       UMINUS(J)=GMINUS(J)
55       UPLUS(J)=GPLUS(J)
56  60   CONTINUE
57       CALL BOUNDS(IBUC,PARENT,ISTOR,RSTOR,UMINUS,UPLUS)
58       IF(INTDEG.GE.0) GOTO 70
59       CALL USRINT(UMINUS,UPLUS,RSTOR(BUCPTR),RSTOR(BUCPTR+1),RFINT,RERR
60      1SQ)
61       FUNINT=FUNINT+RFINT
62       ERROR=ERROR+RERRSQ
63       BUCPTR=BUCPTR+MAXWRD
64       GOTO 180
65  70   IF(DEGREE.NE.1) GOTO 80
66       CELVOL=RSTOR(BUCPTR+6)
67       GOTO 100
68  80   CELVOL=1.0E+0
69       DO 90 J=1,NDIM
70       CELVOL=CELVOL*(UPLUS(J)-UMINUS(J))
71  90   CONTINUE
72  100  IF(INTDEG.LE.1) GOTO 110
73       FUNINT=FUNINT+QUAD(NDIM,INTDEG,UMINUS,UPLUS,FUN)*CELVOL
74       GOTO 180
75  110  IF(INTDEG.NE.1) GOTO 120
76       NIBUC=INT(SQRT(RSTOR(BUCPTR+1))*NTOT/ERRTOT+0.5)
77       IF(NIBUC.GE.5) GOTO 130
78       FUNINT=FUNINT+RSTOR(BUCPTR)
79       ERROR=ERROR+RSTOR(BUCPTR+1)
80       BUCPTR=BUCPTR+MAXWRD
81       GOTO 180
82  120  NIBUC=NPOINT
83       CALL QUASI(XX,NDIM,NIBUC,-NPOINT)
84  130  PTR=ISCR
85       FINT=0.0E+0
86       ERRSQ=FINT
87       DO 170 J=1,NIBUC
88       IF(INTDEG.NE.1) GOTO 140
89       CALL RANUMS(RSTOR(PTR+1),NDIM)
90       GOTO 150
91  140  CALL QUASI(RSTOR(PTR+1),NDIM,1,NIBUC)
92  150  DO 160 I=1,NDIM
93       RSTOR(I+PTR)=(UPLUS(I)-UMINUS(I))*RSTOR(I+PTR)+UMINUS(I)
94  160  CONTINUE
95       F=FUN(NDIM,RSTOR(PTR+1))
96       FINT=FINT+F
97       IF(ABS(F).GT.1.0E-37) ERRSQ=ERRSQ+F**2
98  170  CONTINUE
99       FINT=FINT/NIBUC
100       ERRSQ=ERRSQ/NIBUC
101       ERRSQ=ERRSQ-FINT**2
102       FINT=FINT*CELVOL
103       ERRSQ=ERRSQ*CELVOL**2
104       IF(INTDEG.EQ.0) ERRSQ=RSTOR(BUCPTR+1)/NIBUC
105       ERRSQ=ERRSQ/NIBUC
106       FUNINT=FUNINT+FINT
107       ERROR=ERROR+ERRSQ
108       NFUN=NFUN+NIBUC
109       RSTOR(BUCPTR)=FINT
110       BUCPTR=BUCPTR+MAXWRD
111  180  CONTINUE
112       IF(ERROR.GT.0) ERROR=SQRT(ERROR)
113       IF(IPRINT.LE.0) GOTO 200
114       WRITE(6,190) FUNINT,ERROR,NFUN
115  190  FORMAT(' INTEGRAL ESTIMATE = ',G13.5,'   +/-',G13.5/1X,
116      1 I10,' TOTAL INTEGRAND EVALUATIONS')
117  200  RETURN
118       END