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