7 DOUBLE PRECISION FUNCTION gaus(F,A,B,EEPS)
9 IMPLICIT REAL*8(a-h,o-z)
14 1/0.10122 85362 90376, 0.22238 10344 53374, 0.31370 66458 77887,
15 2 0.36268 37833 78362, 0.02715 24594 11754, 0.06225 35239 38648,
16 3 0.09515 85116 82493, 0.12462 89712 55534, 0.14959 59888 16577,
17 4 0.16915 65193 95003, 0.18260 34150 44924, 0.18945 06104 55069/
19 1/0.96028 98564 97536, 0.79666 64774 13627, 0.52553 24099 16329,
20 2 0.18343 46424 95650, 0.98940 09349 91650, 0.94457 50230 73233,
21 3 0.86563 12023 87832, 0.75540 44083 55003, 0.61787 62444 02644,
22 4 0.45801 67776 57227, 0.28160 35507 79259, 0.09501 25098 37637/
31 CALL changegauss(f,a,b,2,result,eps)
42 IF(dabs(y) .LE. delta)
RETURN
50 1 s8=s8+w(i)*(f(c1+u)+f(c1-u))
53 3 s16=s16+w(i)*(f(c1+u)+f(c1-u))
57 IF(dabs(s16-s8) .GT. eps*dabs(s16))
GO TO 4
59 IF(dabs(s16-s8) .GT. eps)
GO TO 4
65 IF(dabs(y) .GT. delta)
GOTO 2
69 7
FORMAT(1x,36hgaus ... too high accuracy required)
73 DOUBLE PRECISION FUNCTION gaus2(F,A,B,EEPS)
75 IMPLICIT REAL*8(a-h,o-z)
80 1/0.10122 85362 90376, 0.22238 10344 53374, 0.31370 66458 77887,
81 2 0.36268 37833 78362, 0.02715 24594 11754, 0.06225 35239 38648,
82 3 0.09515 85116 82493, 0.12462 89712 55534, 0.14959 59888 16577,
83 4 0.16915 65193 95003, 0.18260 34150 44924, 0.18945 06104 55069/
85 1/0.96028 98564 97536, 0.79666 64774 13627, 0.52553 24099 16329,
86 2 0.18343 46424 95650, 0.98940 09349 91650, 0.94457 50230 73233,
87 3 0.86563 12023 87832, 0.75540 44083 55003, 0.61787 62444 02644,
88 4 0.45801 67776 57227, 0.28160 35507 79259, 0.09501 25098 37637/
97 CALL changegauss2(f,a,b,2,result,eps)
104 delta=const*dabs(a-b)
108 IF(dabs(y) .LE. delta)
RETURN
116 1 s8=s8+w(i)*(f(c1+u)+f(c1-u))
119 3 s16=s16+w(i)*(f(c1+u)+f(c1-u))
123 IF(dabs(s16-s8) .GT. eps*dabs(s16))
GO TO 4
125 IF(dabs(s16-s8) .GT. eps)
GO TO 4
131 IF(dabs(y) .GT. delta)
GOTO 2
135 7
FORMAT(1x,36hgaus2 ... too high accuracy required)
138 DOUBLE PRECISION FUNCTION gaus3(F,A,B,EEPS)
140 IMPLICIT REAL*8(a-h,o-z)
142 dimension w(12),x(12)
145 1/0.10122 85362 90376, 0.22238 10344 53374, 0.31370 66458 77887,
146 2 0.36268 37833 78362, 0.02715 24594 11754, 0.06225 35239 38648,
147 3 0.09515 85116 82493, 0.12462 89712 55534, 0.14959 59888 16577,
148 4 0.16915 65193 95003, 0.18260 34150 44924, 0.18945 06104 55069/
150 1/0.96028 98564 97536, 0.79666 64774 13627, 0.52553 24099 16329,
151 2 0.18343 46424 95650, 0.98940 09349 91650, 0.94457 50230 73233,
152 3 0.86563 12023 87832, 0.75540 44083 55003, 0.61787 62444 02644,
153 4 0.45801 67776 57227, 0.28160 35507 79259, 0.09501 25098 37637/
162 CALL changegauss3(f,a,b,2,result,eps)
169 delta=const*dabs(a-b)
173 IF(dabs(y) .LE. delta)
RETURN
181 1 s8=s8+w(i)*(f(c1+u)+f(c1-u))
184 3 s16=s16+w(i)*(f(c1+u)+f(c1-u))
188 IF(dabs(s16-s8) .GT. eps*dabs(s16))
GO TO 4
190 IF(dabs(s16-s8) .GT. eps)
GO TO 4
196 IF(dabs(y) .GT. delta)
GOTO 2
200 7
FORMAT(1x,36hgaus3 ... too high accuracy required)
214 SUBROUTINE stepgauss(F,A,B,LAMBDA,RESULT,EPS)
215 implicit real*8 (a-h,o-z)
216 dimension w(12),x(12)
218 1/0.10122 85362 90376, 0.22238 10344 53374, 0.31370 66458 77887,
219 2 0.36268 37833 78362, 0.02715 24594 11754, 0.06225 35239 38648,
220 3 0.09515 85116 82493, 0.12462 89712 55534, 0.14959 59888 16577,
221 4 0.16915 65193 95003, 0.18260 34150 44924, 0.18945 06104 55069/
223 1/0.96028 98564 97536, 0.79666 64774 13627, 0.52553 24099 16329,
224 2 0.18343 46424 95650, 0.98940 09349 91650, 0.94457 50230 73233,
225 3 0.86563 12023 87832, 0.75540 44083 55003, 0.61787 62444 02644,
226 4 0.45801 67776 57227, 0.28160 35507 79259, 0.09501 25098 37637/
230 c=(b-a)/float(lambda)
240 2 s8=s8+w(j)*(f(c1+u)+f(c1-u))
243 3 s16=s16+w(j)*(f(c1+u)+f(c1-u))
245 eps=eps+abs(c2*(s16-s8))
250 SUBROUTINE stepgauss2(F,A,B,LAMBDA,RESULT,EPS)
251 implicit real*8 (a-h,o-z)
252 dimension w(12),x(12)
254 1/0.10122 85362 90376, 0.22238 10344 53374, 0.31370 66458 77887,
255 2 0.36268 37833 78362, 0.02715 24594 11754, 0.06225 35239 38648,
256 3 0.09515 85116 82493, 0.12462 89712 55534, 0.14959 59888 16577,
257 4 0.16915 65193 95003, 0.18260 34150 44924, 0.18945 06104 55069/
259 1/0.96028 98564 97536, 0.79666 64774 13627, 0.52553 24099 16329,
260 2 0.18343 46424 95650, 0.98940 09349 91650, 0.94457 50230 73233,
261 3 0.86563 12023 87832, 0.75540 44083 55003, 0.61787 62444 02644,
262 4 0.45801 67776 57227, 0.28160 35507 79259, 0.09501 25098 37637/
266 c=(b-a)/float(lambda)
276 2 s8=s8+w(j)*(f(c1+u)+f(c1-u))
279 3 s16=s16+w(j)*(f(c1+u)+f(c1-u))
281 eps=eps+abs(c2*(s16-s8))
286 SUBROUTINE stepgauss3(F,A,B,LAMBDA,RESULT,EPS)
287 implicit real*8 (a-h,o-z)
288 dimension w(12),x(12)
290 1/0.10122 85362 90376, 0.22238 10344 53374, 0.31370 66458 77887,
291 2 0.36268 37833 78362, 0.02715 24594 11754, 0.06225 35239 38648,
292 3 0.09515 85116 82493, 0.12462 89712 55534, 0.14959 59888 16577,
293 4 0.16915 65193 95003, 0.18260 34150 44924, 0.18945 06104 55069/
295 1/0.96028 98564 97536, 0.79666 64774 13627, 0.52553 24099 16329,
296 2 0.18343 46424 95650, 0.98940 09349 91650, 0.94457 50230 73233,
297 3 0.86563 12023 87832, 0.75540 44083 55003, 0.61787 62444 02644,
298 4 0.45801 67776 57227, 0.28160 35507 79259, 0.09501 25098 37637/
302 c=(b-a)/float(lambda)
312 2 s8=s8+w(j)*(f(c1+u)+f(c1-u))
315 3 s16=s16+w(j)*(f(c1+u)+f(c1-u))
317 eps=eps+abs(c2*(s16-s8))
325 DOUBLE PRECISION FUNCTION f_change(X,F,AMS1,AMS2)
329 DOUBLE PRECISION X, NEW_X
330 DOUBLE PRECISION AMS1,AMS2
331 DOUBLE PRECISION ALP1,ALP2,ALP
332 DOUBLE PRECISION AMRX,GAMRX
333 DATA amrx/0.77/,gamrx/1.8/
335 alp1 = atan((ams1-amrx**2)/amrx/gamrx)
336 alp2 = atan((ams2-amrx**2)/amrx/gamrx)
337 alp = alp1 + x*(alp2-alp1)
339 new_x = amrx**2+amrx*gamrx*tan(alp)
344 f_change = f_change * (alp2-alp1) * ((new_x-amrx**2)**2+(amrx*gamrx
349 DOUBLE PRECISION FUNCTION f_change2(X,F,AMS1,AMS2)
353 DOUBLE PRECISION X, NEW_X
354 DOUBLE PRECISION AMS1,AMS2
355 DOUBLE PRECISION ALP1,ALP2,ALP
356 DOUBLE PRECISION AMRX,GAMRX
357 DATA amrx/0.77/,gamrx/1.8/
359 alp1 = atan((ams1-amrx**2)/amrx/gamrx)
360 alp2 = atan((ams2-amrx**2)/amrx/gamrx)
361 alp = alp1 + x*(alp2-alp1)
363 new_x = amrx**2+amrx*gamrx*tan(alp)
368 f_change2 = f_change2 * (alp2-alp1) * ((new_x-amrx**2)**2+(amrx*gamrx
373 DOUBLE PRECISION FUNCTION f_change3(X,F,AMS1,AMS2)
377 DOUBLE PRECISION X, NEW_X
378 DOUBLE PRECISION AMS1,AMS2
379 DOUBLE PRECISION ALP1,ALP2,ALP
380 DOUBLE PRECISION AMRX,GAMRX
381 DATA amrx/0.77/,gamrx/1.8/
383 alp1 = atan((ams1-amrx**2)/amrx/gamrx)
384 alp2 = atan((ams2-amrx**2)/amrx/gamrx)
385 alp = alp1 + x*(alp2-alp1)
387 new_x = amrx**2+amrx*gamrx*tan(alp)
392 f_change3 = f_change3 * (alp2-alp1) * ((new_x-amrx**2)**2+(amrx*gamrx
400 SUBROUTINE changegauss(F,AMS1,AMS2,LAMBDA,RESULT,EPS)
401 implicit real*8 (a-h,o-z)
403 dimension w(12),x(12)
405 1/0.10122 85362 90376, 0.22238 10344 53374, 0.31370 66458 77887,
406 2 0.36268 37833 78362, 0.02715 24594 11754, 0.06225 35239 38648,
407 3 0.09515 85116 82493, 0.12462 89712 55534, 0.14959 59888 16577,
408 4 0.16915 65193 95003, 0.18260 34150 44924, 0.18945 06104 55069/
410 1/0.96028 98564 97536, 0.79666 64774 13627, 0.52553 24099 16329,
411 2 0.18343 46424 95650, 0.98940 09349 91650, 0.94457 50230 73233,
412 3 0.86563 12023 87832, 0.75540 44083 55003, 0.61787 62444 02644,
413 4 0.45801 67776 57227, 0.28160 35507 79259, 0.09501 25098 37637/
423 c=(b-a)/float(lambda)
433 2 s8=s8+w(j)*(f_change(c1+u,f,ams1,ams2)+f_change(c1-u,f,ams1,ams2))
436 3 s16=s16+w(j)*(f_change(c1+u,f,ams1,ams2)+f_change(c1-u,f,ams1,ams2
438 eps=eps+abs(c2*(s16-s8))
443 SUBROUTINE changegauss2(F,AMS1,AMS2,LAMBDA,RESULT,EPS)
444 implicit real*8 (a-h,o-z)
446 dimension w(12),x(12)
448 1/0.10122 85362 90376, 0.22238 10344 53374, 0.31370 66458 77887,
449 2 0.36268 37833 78362, 0.02715 24594 11754, 0.06225 35239 38648,
450 3 0.09515 85116 82493, 0.12462 89712 55534, 0.14959 59888 16577,
451 4 0.16915 65193 95003, 0.18260 34150 44924, 0.18945 06104 55069/
453 1/0.96028 98564 97536, 0.79666 64774 13627, 0.52553 24099 16329,
454 2 0.18343 46424 95650, 0.98940 09349 91650, 0.94457 50230 73233,
455 3 0.86563 12023 87832, 0.75540 44083 55003, 0.61787 62444 02644,
456 4 0.45801 67776 57227, 0.28160 35507 79259, 0.09501 25098 37637/
466 c=(b-a)/float(lambda)
476 2 s8=s8+w(j)*(f_change2(c1+u,f,ams1,ams2)+f_change2(c1-u,f,ams1,ams2
479 3 s16=s16+w(j)*(f_change2(c1+u,f,ams1,ams2)+f_change2(c1-u,f,ams1,ams2
481 eps=eps+abs(c2*(s16-s8))
486 SUBROUTINE changegauss3(F,AMS1,AMS2,LAMBDA,RESULT,EPS)
487 implicit real*8 (a-h,o-z)
489 dimension w(12),x(12)
491 1/0.10122 85362 90376, 0.22238 10344 53374, 0.31370 66458 77887,
492 2 0.36268 37833 78362, 0.02715 24594 11754, 0.06225 35239 38648,
493 3 0.09515 85116 82493, 0.12462 89712 55534, 0.14959 59888 16577,
494 4 0.16915 65193 95003, 0.18260 34150 44924, 0.18945 06104 55069/
496 1/0.96028 98564 97536, 0.79666 64774 13627, 0.52553 24099 16329,
497 2 0.18343 46424 95650, 0.98940 09349 91650, 0.94457 50230 73233,
498 3 0.86563 12023 87832, 0.75540 44083 55003, 0.61787 62444 02644,
499 4 0.45801 67776 57227, 0.28160 35507 79259, 0.09501 25098 37637/
509 c=(b-a)/float(lambda)
519 2 s8=s8+w(j)*(f_change3(c1+u,f,ams1,ams2)+f_change3(c1-u,f,ams1,ams2
522 3 s16=s16+w(j)*(f_change3(c1+u,f,ams1,ams2)+f_change3(c1-u,f,ams1,ams2
524 eps=eps+abs(c2*(s16-s8))