Dummy subroutines to avoid files with no code in
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / d / gauss128.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1999/05/18 15:55:34  fca
6 * AliRoot sources
7 *
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
17 C     QGAUSS FOR IBM AND ALIKE
18 #endif
19 #if !defined(CERNLIB_DOUBLE)
20       FUNCTION DGAUSS(F,A,B,EPS)
21
22 C     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
129 #else
130       SUBROUTINE gauss128_dummy
131       END
132 #endif