Adding macros to create Calibration objects
[u/mrichter/AliRoot.git] / HIJING / hijing1_36 / gauss4.F
1 * $Id$
2 C
3 C
4 C
5 C
6         FUNCTION GAUSS4(F,A,B,EPS)
7         EXTERNAL F
8         DIMENSION W(12),X(12)
9         DATA CONST/1.0E-12/
10         DATA W/0.1012285,.2223810,.3137067,.3623838,.0271525,
11      &         .0622535,0.0951585,.1246290,.1495960,.1691565,
12      &         .1826034,.1894506/
13         DATA X/0.9602899,.7966665,.5255324,.1834346,.9894009,
14      &         .9445750,0.8656312,.7554044,.6178762,.4580168,
15      &         .2816036,.0950125/
16         SAVE
17         DELTA=CONST*ABS(A-B)
18         GAUSS4=0.0
19         AA=A
20 5       Y=B-AA
21         IF(ABS(Y).LE.DELTA) RETURN
22 2       BB=AA+Y
23         C1=0.5*(AA+BB)
24         C2=C1-AA
25         S8=0.0
26         S16=0.0
27         DO 1 I=1,4
28         U=X(I)*C2
29 1       S8=S8+W(I)*(F(C1+U)+F(C1-U))
30         DO 3 I=5,12
31         U=X(I)*C2
32 3       S16=S16+W(I)*(F(C1+U)+F(C1-U))
33         S8=S8*C2
34         S16=S16*C2
35         IF(ABS(S16-S8).GT.EPS*(1.+ABS(S16))) GOTO 4
36         GAUSS4=GAUSS4+S16
37         AA=BB
38         GOTO 5
39 4       Y=0.5*Y
40         IF(ABS(Y).GT.DELTA) GOTO 2
41         WRITE(6,7)
42         GAUSS4=0.0
43         RETURN
44 7       FORMAT(1X,'GAUSS4....TOO HIGH ACURACY REQUIRED')
45         END