This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / d / rgmlt64.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:02:15  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10 #if !defined(CERNLIB_DOUBLE)
11       FUNCTION RGMLT1(FSUB1,A,B,NI,NG,X)
12 #endif
13 #if defined(CERNLIB_DOUBLE)
14       FUNCTION DGMLT1(FSUB1,A,B,NI,NG,X)
15 #include "gen/imp64.inc"
16 #endif
17
18       CHARACTER NAME*(*)
19       CHARACTER*80 ERRTXT
20 #if !defined(CERNLIB_DOUBLE)
21       PARAMETER (NAME = 'RGMLT1')
22 #endif
23 #if defined(CERNLIB_DOUBLE)
24       PARAMETER (NAME = 'DGMLT1')
25 #endif
26       PARAMETER (Z1 = 1, HALF = Z1/2)
27
28       DIMENSION X(6),W(14),T(14),V(64),U(64),F(64)
29
30       DATA (T(I),W(I),I=1,14)
31      1/-0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
32      2 -0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
33      3 -0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
34      4  0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
35      5  0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
36      6  0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
37      7 -0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0,
38      8 -0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
39      9 -0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
40      A -0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
41      B  0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
42      C  0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
43      D  0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
44      E  0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0/
45
46       IF(NI .LE. 0) THEN
47        WRITE(ERRTXT,101) NI
48        CALL MTLPRT(NAME,'D110.1',ERRTXT)
49        STOP
50       END IF
51       M0=NG
52       IF(M0 .NE. 8) M0=6
53       I0=0
54       IF(M0 .EQ. 8) I0=6
55       D=(B-A)/NI
56       R=HALF*D
57       RA=R+A
58       MV=MOD(M0*NI-1,64)+1
59       S=0
60       J=0
61       DO 1 I = 1+I0,M0+I0
62       RTA=R*T(I)+RA
63       DO 2 K = 1,NI
64       J=J+1
65       V(J)=W(I)
66       U(J)=RTA+(K-1)*D
67       IF(J .EQ. MV) THEN
68        CALL FSUB1(MV,U,F,X)
69        DO 3 J = 1,MV
70     3  S=S+V(J)*F(J)
71        MV=64
72        J=0
73       END IF
74     2 CONTINUE
75     1 CONTINUE
76 #if !defined(CERNLIB_DOUBLE)
77       RGMLT1=R*S
78 #endif
79 #if defined(CERNLIB_DOUBLE)
80       DGMLT1=R*S
81 #endif
82       RETURN
83   101 FORMAT('N1 = ',I4,' <= 0')
84       END
85 #if !defined(CERNLIB_DOUBLE)
86       FUNCTION RGMLT2(FSUB2,A,B,NI,NG,X)
87 #endif
88 #if defined(CERNLIB_DOUBLE)
89       FUNCTION DGMLT2(FSUB2,A,B,NI,NG,X)
90 #include "gen/imp64.inc"
91 #endif
92
93       CHARACTER NAME*(*)
94       CHARACTER*80 ERRTXT
95 #if !defined(CERNLIB_DOUBLE)
96       PARAMETER (NAME = 'RGMLT2')
97 #endif
98 #if defined(CERNLIB_DOUBLE)
99       PARAMETER (NAME = 'DGMLT2')
100 #endif
101       PARAMETER (Z1 = 1, HALF = Z1/2)
102
103        DIMENSION X(6),W(14),T(14),V(64),U(64),F(64)
104
105       DATA (T(I),W(I),I=1,14)
106      1/-0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
107      2 -0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
108      3 -0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
109      4  0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
110      5  0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
111      6  0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
112      7 -0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0,
113      8 -0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
114      9 -0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
115      A -0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
116      B  0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
117      C  0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
118      D  0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
119      E  0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0/
120
121       IF(NI .LE. 0) THEN
122        WRITE(ERRTXT,101) NI
123        CALL MTLPRT(NAME,'D110.1',ERRTXT)
124       END IF
125       M0=NG
126       IF(M0 .NE. 8) M0=6
127       I0=0
128       IF(M0 .EQ. 8) I0=6
129       D=(B-A)/NI
130       R=HALF*D
131       RA=R+A
132       MV=MOD(M0*NI-1,64)+1
133       S=0
134       J=0
135       DO 1 I = 1+I0,M0+I0
136       RTA=R*T(I)+RA
137       DO 2 K = 1,NI
138       J=J+1
139       V(J)=W(I)
140       U(J)=RTA+(K-1)*D
141       IF(J .EQ. MV) THEN
142        CALL FSUB2(MV,U,F,X)
143        DO 3 J = 1,MV
144     3  S=S+V(J)*F(J)
145        MV=64
146        J=0
147       END IF
148     2 CONTINUE
149     1 CONTINUE
150 #if !defined(CERNLIB_DOUBLE)
151       RGMLT2=R*S
152 #endif
153 #if defined(CERNLIB_DOUBLE)
154       DGMLT2=R*S
155 #endif
156       RETURN
157   101 FORMAT('N2 = ',I4,' <= 0')
158       END
159 #if !defined(CERNLIB_DOUBLE)
160       FUNCTION RGMLT3(FSUB3,A,B,NI,NG,X)
161 #endif
162 #if defined(CERNLIB_DOUBLE)
163       FUNCTION DGMLT3(FSUB3,A,B,NI,NG,X)
164 #include "gen/imp64.inc"
165 #endif
166       CHARACTER NAME*(*)
167       CHARACTER*80 ERRTXT
168 #if !defined(CERNLIB_DOUBLE)
169       PARAMETER (NAME = 'RGMLT3')
170 #endif
171 #if defined(CERNLIB_DOUBLE)
172       PARAMETER (NAME = 'DGMLT3')
173 #endif
174       PARAMETER (Z1 = 1, HALF = Z1/2)
175
176       DIMENSION X(6),W(14),T(14),V(64),U(64),F(64)
177
178       DATA (T(I),W(I),I=1,14)
179      1/-0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
180      2 -0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
181      3 -0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
182      4  0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
183      5  0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
184      6  0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
185      7 -0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0,
186      8 -0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
187      9 -0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
188      A -0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
189      B  0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
190      C  0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
191      D  0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
192      E  0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0/
193
194       IF(NI .LE. 0) THEN
195        WRITE(ERRTXT,101) NI
196        CALL MTLPRT(NAME,'D110.1',ERRTXT)
197        STOP
198       END IF
199       M0=NG
200       IF(M0 .NE. 8) M0=6
201       I0=0
202       IF(M0 .EQ. 8) I0=6
203       D=(B-A)/NI
204       R=HALF*D
205       RA=R+A
206       MV=MOD(M0*NI-1,64)+1
207       S=0
208       J=0
209       DO 1 I = 1+I0,M0+I0
210       RTA=R*T(I)+RA
211       DO 2 K = 1,NI
212       J=J+1
213       V(J)=W(I)
214       U(J)=RTA+(K-1)*D
215       IF(J .EQ. MV) THEN
216        CALL FSUB3(MV,U,F,X)
217        DO 3 J = 1,MV
218     3  S=S+V(J)*F(J)
219        MV=64
220        J=0
221       END IF
222     2 CONTINUE
223     1 CONTINUE
224 #if !defined(CERNLIB_DOUBLE)
225       RGMLT3=R*S
226 #endif
227 #if defined(CERNLIB_DOUBLE)
228       DGMLT3=R*S
229 #endif
230       RETURN
231   101 FORMAT('N3 = ',I4,' <= 0')
232       END
233 #if !defined(CERNLIB_DOUBLE)
234       FUNCTION RGMLT4(FSUB4,A,B,NI,NG,X)
235 #endif
236 #if defined(CERNLIB_DOUBLE)
237       FUNCTION DGMLT4(FSUB4,A,B,NI,NG,X)
238 #include "gen/imp64.inc"
239 #endif
240       CHARACTER NAME*(*)
241       CHARACTER*80 ERRTXT
242 #if !defined(CERNLIB_DOUBLE)
243       PARAMETER (NAME = 'RGMLT4')
244 #endif
245 #if defined(CERNLIB_DOUBLE)
246       PARAMETER (NAME = 'DGMLT4')
247 #endif
248       PARAMETER (Z1 = 1, HALF = Z1/2)
249
250       DIMENSION X(6),W(14),T(14),V(64),U(64),F(64)
251
252       DATA (T(I),W(I),I=1,14)
253      1/-0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
254      2 -0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
255      3 -0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
256      4  0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
257      5  0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
258      6  0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
259      7 -0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0,
260      8 -0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
261      9 -0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
262      A -0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
263      B  0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
264      C  0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
265      D  0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
266      E  0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0/
267
268       IF(NI .LE. 0) THEN
269        WRITE(ERRTXT,101) NI
270        CALL MTLPRT(NAME,'D110.1',ERRTXT)
271        STOP
272       END IF
273       M0=NG
274       IF(M0 .NE. 8) M0=6
275       I0=0
276       IF(M0 .EQ. 8) I0=6
277       D=(B-A)/NI
278       R=HALF*D
279       RA=R+A
280       MV=MOD(M0*NI-1,64)+1
281       S=0
282       J=0
283       DO 1 I = 1+I0,M0+I0
284       RTA=R*T(I)+RA
285       DO 2 K = 1,NI
286       J=J+1
287       V(J)=W(I)
288       U(J)=RTA+(K-1)*D
289       IF(J .EQ. MV) THEN
290        CALL FSUB4(MV,U,F,X)
291        DO 3 J = 1,MV
292     3  S=S+V(J)*F(J)
293        MV=64
294        J=0
295       END IF
296     2 CONTINUE
297     1 CONTINUE
298 #if !defined(CERNLIB_DOUBLE)
299       RGMLT4=R*S
300 #endif
301 #if defined(CERNLIB_DOUBLE)
302       DGMLT4=R*S
303 #endif
304       RETURN
305   101 FORMAT('N4 = ',I4,' <= 0')
306       END
307 #if !defined(CERNLIB_DOUBLE)
308       FUNCTION RGMLT5(FSUB5,A,B,NI,NG,X)
309 #endif
310 #if defined(CERNLIB_DOUBLE)
311       FUNCTION DGMLT5(FSUB5,A,B,NI,NG,X)
312 #include "gen/imp64.inc"
313 #endif
314       CHARACTER NAME*(*)
315       CHARACTER*80 ERRTXT
316 #if !defined(CERNLIB_DOUBLE)
317       PARAMETER (NAME = 'RGMLT5')
318 #endif
319 #if defined(CERNLIB_DOUBLE)
320       PARAMETER (NAME = 'DGMLT5')
321 #endif
322       PARAMETER (Z1 = 1, HALF = Z1/2)
323
324       DIMENSION X(6),W(14),T(14),V(64),U(64),F(64)
325
326       DATA (T(I),W(I),I=1,14)
327      1/-0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
328      2 -0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
329      3 -0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
330      4  0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
331      5  0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
332      6  0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
333      7 -0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0,
334      8 -0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
335      9 -0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
336      A -0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
337      B  0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
338      C  0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
339      D  0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
340      E  0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0/
341
342       IF(NI .LE. 0) THEN
343        WRITE(ERRTXT,101) NI
344        CALL MTLPRT(NAME,'D110.1',ERRTXT)
345        STOP
346       END IF
347       M0=NG
348       IF(M0 .NE. 8) M0=6
349       I0=0
350       IF(M0 .EQ. 8) I0=6
351       D=(B-A)/NI
352       R=HALF*D
353       RA=R+A
354       MV=MOD(M0*NI-1,64)+1
355       S=0
356       J=0
357       DO 1 I = 1+I0,M0+I0
358       RTA=R*T(I)+RA
359       DO 2 K = 1,NI
360       J=J+1
361       V(J)=W(I)
362       U(J)=RTA+(K-1)*D
363       IF(J .EQ. MV) THEN
364        CALL FSUB5(MV,U,F,X)
365        DO 3 J = 1,MV
366     3  S=S+V(J)*F(J)
367        MV=64
368        J=0
369       END IF
370     2 CONTINUE
371     1 CONTINUE
372 #if !defined(CERNLIB_DOUBLE)
373       RGMLT5=R*S
374 #endif
375 #if defined(CERNLIB_DOUBLE)
376       DGMLT5=R*S
377 #endif
378       RETURN
379   101 FORMAT('N5 = ',I4,' <= 0')
380       END
381 #if !defined(CERNLIB_DOUBLE)
382       FUNCTION RGMLT6(FSUB6,A,B,NI,NG,X)
383 #endif
384 #if defined(CERNLIB_DOUBLE)
385       FUNCTION DGMLT6(FSUB6,A,B,NI,NG,X)
386 #include "gen/imp64.inc"
387 #endif
388       CHARACTER NAME*(*)
389       CHARACTER*80 ERRTXT
390 #if !defined(CERNLIB_DOUBLE)
391       PARAMETER (NAME = 'RGMLT6')
392 #endif
393 #if defined(CERNLIB_DOUBLE)
394       PARAMETER (NAME = 'DGMLT6')
395 #endif
396       PARAMETER (Z1 = 1, HALF = Z1/2)
397
398       DIMENSION X(6),W(14),T(14),V(64),U(64),F(64)
399
400       DATA (T(I),W(I),I=1,14)
401      1/-0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
402      2 -0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
403      3 -0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
404      4  0.23861 91860 83196 909D0, 0.46791 39345 72691 047D0,
405      5  0.66120 93864 66264 514D0, 0.36076 15730 48138 608D0,
406      6  0.93246 95142 03152 028D0, 0.17132 44923 79170 345D0,
407      7 -0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0,
408      8 -0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
409      9 -0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
410      A -0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
411      B  0.18343 46424 95649 805D0, 0.36268 37833 78361 983D0,
412      C  0.52553 24099 16328 986D0, 0.31370 66458 77887 287D0,
413      D  0.79666 64774 13626 740D0, 0.22238 10344 53374 471D0,
414      E  0.96028 98564 97536 232D0, 0.10122 85362 90376 259D0/
415
416       IF(NI .LE. 0) THEN
417        WRITE(ERRTXT,101) NI
418        CALL MTLPRT(NAME,'D110.1',ERRTXT)
419        STOP
420       END IF
421       M0=NG
422       IF(M0 .NE. 8) M0=6
423       I0=0
424       IF(M0 .EQ. 8) I0=6
425       D=(B-A)/NI
426       R=HALF*D
427       RA=R+A
428       MV=MOD(M0*NI-1,64)+1
429       S=0
430       J=0
431       DO 1 I = 1+I0,M0+I0
432       RTA=R*T(I)+RA
433       DO 2 K = 1,NI
434       J=J+1
435       V(J)=W(I)
436       U(J)=RTA+(K-1)*D
437       IF(J .EQ. MV) THEN
438        CALL FSUB6(MV,U,F,X)
439        DO 3 J = 1,MV
440     3  S=S+V(J)*F(J)
441        MV=64
442        J=0
443       END IF
444     2 CONTINUE
445     1 CONTINUE
446 #if !defined(CERNLIB_DOUBLE)
447       RGMLT6=R*S
448 #endif
449 #if defined(CERNLIB_DOUBLE)
450       DGMLT6=R*S
451 #endif
452       RETURN
453   101 FORMAT('N6 = ',I4,' <= 0')
454       END