1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
real*8 function fprati(p1,f1,p2,f2,p3,f3)
c given three points (p1,f1),(p2,f2) and (p3,f3), function fprati
c gives the value of p such that the rational interpolating function
c of the form r(p) = (u*p+v)/(p+w) equals zero at p.
c ..
c ..scalar arguments..
real*8 p1,f1,p2,f2,p3,f3
c ..local scalars..
real*8 h1,h2,h3,p
c ..
if(p3.gt.0.) go to 10
c value of p in case p3 = infinity.
p = (p1*(f1-f3)*f2-p2*(f2-f3)*f1)/((f1-f2)*f3)
go to 20
c value of p in case p3 ^= infinity.
10 h1 = f1*(f2-f3)
h2 = f2*(f3-f1)
h3 = f3*(f1-f2)
p = -(p1*p2*h3+p2*p3*h1+p3*p1*h2)/(p1*h1+p2*h2+p3*h3)
c adjust the value of p1,f1,p3 and f3 such that f1 > 0 and f3 < 0.
20 if(f2.lt.0.) go to 30
p1 = p2
f1 = f2
go to 40
30 p3 = p2
f3 = f2
40 fprati = p
return
end
|
