Dummy subroutines to avoid files with no code in
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / d / gauss128.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
9fbce831 5* Revision 1.1.1.1 1999/05/18 15:55:34 fca
6* AliRoot sources
7*
fe4da5cc 8* Revision 1.1.1.1 1996/04/01 15:02:13 mclareni
9* Mathlib gen
10*
11*
12#include "gen/pilot.h"
13#if defined(CERNLIB_QUAD)
14#if defined(CERNLIB_DOUBLE)
15 FUNCTION QGAUSS(F,A,B,EPS)
16
17C QGAUSS FOR IBM AND ALIKE
18#endif
19#if !defined(CERNLIB_DOUBLE)
20 FUNCTION DGAUSS(F,A,B,EPS)
21
22C DGAUSS FOR CRAY AND ALIKE
23#endif
24#include "gen/imp128.inc"
25 CHARACTER NAME*(*)
26#if defined(CERNLIB_DOUBLE)
27 PARAMETER (NAME = 'QGAUSS')
28#endif
29#if !defined(CERNLIB_DOUBLE)
30 PARAMETER (NAME = 'DGAUSS')
31#endif
32 DIMENSION W(12),X(12)
33
34 PARAMETER (Z1 = 1, HF = Z1/2, CST = 5*Z1/1000)
35
36 DATA X
37#if defined(CERNLIB_DOUBLE)
38 1 /0.96028 98564 97536 23168 35608 68569 47Q0,
39 2 0.79666 64774 13626 73959 15539 36475 83Q0,
40 3 0.52553 24099 16328 98581 77390 49189 25Q0,
41 4 0.18343 46424 95649 80493 94761 42360 18Q0,
42 5 0.98940 09349 91649 93259 61541 73450 33Q0,
43 6 0.94457 50230 73232 57607 79884 15534 61Q0,
44 7 0.86563 12023 87831 74388 04678 97712 39Q0,
45 8 0.75540 44083 55003 03389 51011 94847 44Q0,
46 9 0.61787 62444 02643 74844 66717 64048 79Q0,
47 A 0.45801 67776 57227 38634 24194 42983 58Q0,
48 B 0.28160 35507 79258 91323 04605 01460 50Q0,
49 C 0.95012 50983 76374 40185 31933 54249 58Q-1/
50
51 DATA W
52 1 /0.10122 85362 90376 25915 25313 54309 96Q0,
53 2 0.22238 10344 53374 47054 43559 94426 24Q0,
54 3 0.31370 66458 77887 28733 79622 01986 60Q0,
55 4 0.36268 37833 78361 98296 51504 49277 20Q0,
56 5 0.27152 45941 17540 94851 78057 24560 18Q-1,
57 6 0.62253 52393 86478 92862 84383 69943 78Q-1,
58 7 0.95158 51168 24927 84809 92510 76022 46Q-1,
59 8 0.12462 89712 55533 87205 24762 82192 02Q0,
60 9 0.14959 59888 16576 73208 15017 30547 48Q0,
61 A 0.16915 65193 95002 53818 93120 79030 36Q0,
62 B 0.18260 34150 44923 58886 67636 67969 22Q0,
63 C 0.18945 06104 55068 49628 53967 23208 28Q0/
64#endif
65#if !defined(CERNLIB_DOUBLE)
66 1 /0.96028 98564 97536 23168 35608 68569 47D0,
67 2 0.79666 64774 13626 73959 15539 36475 83D0,
68 3 0.52553 24099 16328 98581 77390 49189 25D0,
69 4 0.18343 46424 95649 80493 94761 42360 18D0,
70 5 0.98940 09349 91649 93259 61541 73450 33D0,
71 6 0.94457 50230 73232 57607 79884 15534 61D0,
72 7 0.86563 12023 87831 74388 04678 97712 39D0,
73 8 0.75540 44083 55003 03389 51011 94847 44D0,
74 9 0.61787 62444 02643 74844 66717 64048 79D0,
75 A 0.45801 67776 57227 38634 24194 42983 58D0,
76 B 0.28160 35507 79258 91323 04605 01460 50D0,
77 C 0.95012 50983 76374 40185 31933 54249 58D-1/
78
79 DATA W
80 1 /0.10122 85362 90376 25915 25313 54309 96D0,
81 2 0.22238 10344 53374 47054 43559 94426 24D0,
82 3 0.31370 66458 77887 28733 79622 01986 60D0,
83 4 0.36268 37833 78361 98296 51504 49277 20D0,
84 5 0.27152 45941 17540 94851 78057 24560 18D-1,
85 6 0.62253 52393 86478 92862 84383 69943 78D-1,
86 7 0.95158 51168 24927 84809 92510 76022 46D-1,
87 8 0.12462 89712 55533 87205 24762 82192 02D0,
88 9 0.14959 59888 16576 73208 15017 30547 48D0,
89 A 0.16915 65193 95002 53818 93120 79030 36D0,
90 B 0.18260 34150 44923 58886 67636 67969 22D0,
91 C 0.18945 06104 55068 49628 53967 23208 28D0/
92#endif
93
94 H=0
95 IF(B .EQ. A) GO TO 99
96 CONST=CST/ABS(B-A)
97 BB=A
98 1 AA=BB
99 BB=B
100 2 C1=HF*(BB+AA)
101 C2=HF*(BB-AA)
102 S8=0
103 DO 3 I = 1,4
104 U=C2*X(I)
105 3 S8=S8+W(I)*(F(C1+U)+F(C1-U))
106 S16=0
107 DO 4 I = 5,12
108 U=C2*X(I)
109 4 S16=S16+W(I)*(F(C1+U)+F(C1-U))
110 S16=C2*S16
111 IF(ABS(S16-C2*S8) .LE. EPS*(1+ABS(S16))) THEN
112 H=H+S16
113 IF(BB .NE. B) GO TO 1
114 ELSE
115 BB=C1
116 IF(1+CONST*ABS(C2) .NE. 1) GO TO 2
117 H=0
118 CALL MTLPRT(NAME,'D103.1','TOO HIGH ACCURACY REQUIRED')
119 GO TO 99
120 END IF
121#if !defined(CERNLIB_DOUBLE)
122 99 DGAUSS=H
123#endif
124#if defined(CERNLIB_DOUBLE)
125 99 QGAUSS=H
126#endif
127 RETURN
128 END
9fbce831 129#else
130 SUBROUTINE gauss128_dummy
131 END
fe4da5cc 132#endif