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