Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
[COLOR=#a020f0]Program[/color] PPolyn
[COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
[COLOR=#2e8b57][b]real[/b][/color][COLOR=#804040][b]*[/b][/color][COLOR=#ff00ff]8[/color] :: x([COLOR=#ff00ff]100[/color]),y([COLOR=#ff00ff]100[/color]),dydx([COLOR=#ff00ff]100[/color])
[COLOR=#2e8b57][b]real[/b][/color][COLOR=#804040][b]*[/b][/color][COLOR=#ff00ff]8[/color] :: dd
[COLOR=#2e8b57][b]real[/b][/color][COLOR=#804040][b]*[/b][/color][COLOR=#ff00ff]8[/color] :: fx0, fx0x1, fx1x2, fx0x1x2, a0, a1, a2, A, B
[COLOR=#2e8b57][b]integer[/b][/color][COLOR=#804040][b]*[/b][/color][COLOR=#ff00ff]4[/color] :: i,n
n [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]19[/color]
x([COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]0.0[/color]
[COLOR=#804040][b]do[/b][/color] i[COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]2[/color],n
dd [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]0.1[/color]
[COLOR=#804040][b]if[/b][/color]((i[COLOR=#804040][b].eq.[/b][/color][COLOR=#ff00ff]5[/color])[COLOR=#804040][b].or.[/b][/color](i[COLOR=#804040][b].eq.[/b][/color][COLOR=#ff00ff]8[/color])) dd [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]0.2[/color]
x(i) [COLOR=#804040][b]=[/b][/color] x(i[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color])[COLOR=#804040][b]+[/b][/color]dd
[COLOR=#0000ff]! y(i) = x(i)**2[/color]
y(i) [COLOR=#804040][b]=[/b][/color] ([COLOR=#ff00ff]1[/color].[COLOR=#804040][b]/[/b][/color][COLOR=#ff00ff]3[/color].)[COLOR=#804040][b]*[/b][/color]x(i)[COLOR=#804040][b]**[/b][/color][COLOR=#ff00ff]3[/color]
[COLOR=#804040][b]enddo[/b][/color]
[COLOR=#804040][b]open[/b][/color]([COLOR=#ff00ff]1[/color],[COLOR=#804040][b]file[/b][/color][COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]'out.txt'[/color],[COLOR=#804040][b]status[/b][/color][COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]'unknown'[/color])
[COLOR=#804040][b]write[/b][/color] ([COLOR=#804040][b]*[/b][/color],[COLOR=#ff00ff]'(3a10)'[/color]) [COLOR=#ff00ff]'x'[/color], [COLOR=#ff00ff]'y=f(x)'[/color], [COLOR=#ff00ff]'dy/dx'[/color]
[COLOR=#804040][b]write[/b][/color] ([COLOR=#ff00ff]1[/color],[COLOR=#ff00ff]'(3a10)'[/color]) [COLOR=#ff00ff]'x'[/color], [COLOR=#ff00ff]'y=f(x)'[/color], [COLOR=#ff00ff]'dy/dx'[/color]
[COLOR=#804040][b]do[/b][/color] i[COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]2[/color],n[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]
[COLOR=#0000ff]! divided differences[/color]
fx0 [COLOR=#804040][b]=[/b][/color]y(i[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color])
fx0x1 [COLOR=#804040][b]=[/b][/color] (y(i)[COLOR=#804040][b]-[/b][/color]y(i[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]))[COLOR=#804040][b]/[/b][/color](x(i)[COLOR=#804040][b]-[/b][/color]x(i[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]))
fx1x2 [COLOR=#804040][b]=[/b][/color] (y(i[COLOR=#804040][b]+[/b][/color][COLOR=#ff00ff]1[/color])[COLOR=#804040][b]-[/b][/color]y(i))[COLOR=#804040][b]/[/b][/color](x(i[COLOR=#804040][b]+[/b][/color][COLOR=#ff00ff]1[/color])[COLOR=#804040][b]-[/b][/color]x(i))
fx0x1x2 [COLOR=#804040][b]=[/b][/color] (fx1x2 [COLOR=#804040][b]-[/b][/color] fx0x1)[COLOR=#804040][b]/[/b][/color](x(i[COLOR=#804040][b]+[/b][/color][COLOR=#ff00ff]1[/color])[COLOR=#804040][b]-[/b][/color]x(i[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]))
[COLOR=#0000ff]! coefficients of Newton polynomial[/color]
[COLOR=#0000ff]! p2(x) = a0 + a1(x-x0) + a2(x-x0)(x-x1)[/color]
a0 [COLOR=#804040][b]=[/b][/color] fx0
a1 [COLOR=#804040][b]=[/b][/color] fx0x1
a2 [COLOR=#804040][b]=[/b][/color] fx0x1x2
[COLOR=#0000ff]! coefficients of an interpolation parable y(x) = A*x*x + B*x + C[/color]
[COLOR=#0000ff]! and its derivation dy/dx = 2*A*x + B[/color]
A [COLOR=#804040][b]=[/b][/color] a2
B [COLOR=#804040][b]=[/b][/color] a1 [COLOR=#804040][b]-[/b][/color] a2[COLOR=#804040][b]*[/b][/color](x(i[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color])[COLOR=#804040][b]+[/b][/color]x(i))
dydx(i) [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]2[/color][COLOR=#804040][b]*[/b][/color]A[COLOR=#804040][b]*[/b][/color]x(i) [COLOR=#804040][b]+[/b][/color] B
[COLOR=#804040][b]if[/b][/color](i[COLOR=#804040][b].eq.[/b][/color][COLOR=#ff00ff]2[/color]) dydx(i[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]2[/color][COLOR=#804040][b]*[/b][/color]A[COLOR=#804040][b]*[/b][/color]x(i[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]+[/b][/color] B
[COLOR=#804040][b]if[/b][/color](i[COLOR=#804040][b].eq.[/b][/color](n[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color])) dydx(i[COLOR=#804040][b]+[/b][/color][COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]2[/color][COLOR=#804040][b]*[/b][/color]A[COLOR=#804040][b]*[/b][/color]x(i[COLOR=#804040][b]+[/b][/color][COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]+[/b][/color] B
[COLOR=#804040][b]enddo[/b][/color]
[COLOR=#804040][b]do[/b][/color] i[COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]1[/color],n
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#ff00ff]'(3f10.2)'[/color]) x(i), y(i), dydx(i)
[COLOR=#804040][b]write[/b][/color]([COLOR=#ff00ff]1[/color],[COLOR=#ff00ff]'(3f10.2)'[/color]) x(i), y(i), dydx(i)
[COLOR=#804040][b]enddo[/b][/color]
[COLOR=#a020f0]end[/color]
$ ppolyn_rm3
x y=f(x) dy/dx
0.00 0.00 -0.01
0.10 0.00 0.01
0.20 0.00 0.04
0.30 0.01 0.10
0.50 0.04 0.26
0.60 0.07 0.36
0.70 0.11 0.50
0.90 0.24 0.82
1.00 0.33 1.00
1.10 0.44 1.21
1.20 0.58 1.44
1.30 0.73 1.69
1.40 0.91 1.96
1.50 1.13 2.25
1.60 1.37 2.56
1.70 1.64 2.89
1.80 1.94 3.24
1.90 2.29 3.61
2.00 2.67 3.99
We have three equations:
(1) y(i-1) = A*x(i-1)**2 + B*x(i-1) + C
(2) y(i) = A*x(i)**2 + B*x(i) + C
(3) y(i+1) = A*x(i+1)**2 + B*x(i+1) + C
Let us first substract equation (2) from (1):
(4) y(i-1)-y(i) = A*(x(i-1)**2-x(i)**2) + B*(x(i-1)-x(i))
Next we substract equation (3) from (2):
(5) y(i)-y(i+1) = A*(x(i)**2-x(i+1)**2) + B*(x(i)-x(i+1))
Now we multiply equation (4) with (x(i)-x(i+1)):
(6) (y(i-1)-y(i))*(x(i)-x(i+1))
= A*(x(i-1)**2-x(i)**2)*(x(i)-x(i+1)) + B*(x(i-1)-x(i))*(x(i)-x(i+1))
... and equation (5) with (x(i-1)-x(i)):
(7) (y(i)-y(i+1))*(x(i-1)-x(i))
= A*(x(i)**2-x(i+1)**2)*(x(i-1)-x(i)) + B*(x(i)-x(i+1))*(x(i-1)-x(i))
Now we substract equation (7) from equation (6) and B disappears:
(8) (y(i-1)-y(i))*(x(i)-x(i+1)) - (y(i)-y(i+1))*(x(i-1)-x(i))
= A*[(x(i-1)**2-x(i)**2)*(x(i)-x(i+1)) - (x(i)**2-x(i+1)**2)*(x(i-1)-x(i))]
To make this more simple we put:
s1 = (x(i)**2-x(i+1)**2)*(x(i-1)-x(i))
s2 = (x(i-1)**2-x(i)**2)*(x(i)-x(i+1))
r2 = (y(i)-y(i+1))*(x(i-1)-x(i))
r1 = (y(i-1)-y(i))*(x(i)-x(i+1))
and equation (8) becomes:
r1-r2 = A*[s2-s1]
or:
A = (r1-r2)/(s2-s1)
In the same way we can find B by multiplying equation (4) with (x(i)**2-x(i+1)**2) and equation (5) with (x(i-1)**2-x(i)**2) and substract the new equations from each other to eliminate A ... etc, etc.
Then you can try gullipe's parable method, maybe it delivers better result.dongli said:...then made samples (dense enough) for derivative calculation using middle difference. The result is quite good for smooth data, but poor for discontinuous one.
Program PPP
implicit none
real*8 x,y1,y2,y3,dy1,dy2,dy3
integer*4 i,n
character*1 c
c = ','
open(1,file='in.dat',status='unknown')
open(2,file='comp.dat',status='unknown')
n = 21
do i=1,n
x = (i-1)/10.
y1 = x**2
y2 = (1./3.)*x**3
y3 = dsin(x)
write (1,'(f6.3,3(a,f8.3))') x,c,y1,c,y2,c,y3
dy1 = 2*x
dy2 = x**2
dy3 = dcos(x)
write (2,'(f6.3,3(a,f8.3))') x,c,dy1,c,dy2,c,dy3
enddo
end
.000, .000, .000, .000
.100, .010, .000, .100
.200, .040, .003, .199
.300, .090, .009, .296
.400, .160, .021, .389
.500, .250, .042, .479
.600, .360, .072, .565
.700, .490, .114, .644
.800, .640, .171, .717
.900, .810, .243, .783
1.000, 1.000, .333, .841
1.100, 1.210, .444, .891
1.200, 1.440, .576, .932
1.300, 1.690, .732, .964
1.400, 1.960, .915, .985
1.500, 2.250, 1.125, .997
1.600, 2.560, 1.365, 1.000
1.700, 2.890, 1.638, .992
1.800, 3.240, 1.944, .974
1.900, 3.610, 2.286, .946
2.000, 4.000, 2.667, .909
.000, .000, .000, 1.000
.100, .200, .010, .995
.200, .400, .040, .980
.300, .600, .090, .955
.400, .800, .160, .921
.500, 1.000, .250, .878
.600, 1.200, .360, .825
.700, 1.400, .490, .765
.800, 1.600, .640, .697
.900, 1.800, .810, .622
1.000, 2.000, 1.000, .540
1.100, 2.200, 1.210, .454
1.200, 2.400, 1.440, .362
1.300, 2.600, 1.690, .267
1.400, 2.800, 1.960, .170
1.500, 3.000, 2.250, .071
1.600, 3.200, 2.560, -.029
1.700, 3.400, 2.890, -.129
1.800, 3.600, 3.240, -.227
1.900, 3.800, 3.610, -.323
2.000, 4.000, 4.000, -.416
Program PPolyn
implicit none
real*8 x(100),y1(100),y2(100),y3(100)
real*8 dy1(100),dy2(100),dy3(100)
integer*4 i,n
character*1 c
c = ','
open(1,file='in.dat',status='old')
n = 1
do while(.true.)
read(1,'(4f20.0)',end=22) x(n),y1(n),y2(n),y3(n)
n = n+1
enddo
22 continue
n = n-1
close(unit=1)
! call derivation(n,x,y1,dy1)
! call derivation(n,x,y2,dy2)
! call derivation(n,x,y3,dy3)
call derivation_Mikrom(n,x,y1,dy1)
call derivation_Mikrom(n,x,y2,dy2)
call derivation_Mikrom(n,x,y3,dy3)
open(2,file='out.dat',status='unknown')
do i=1,n
write(2,'(f6.3,3(a,f8.3))') x(i),c,dy1(i),c,dy2(i),c,dy3(i)
enddo
close(unit=2)
end
! --------------------------------------------------------
Subroutine derivation(n,x,y,dydx)
implicit none
real*8 x(100),y(100),dydx(100)
real*8 r1,r2,r3,r4,s1,s2
real*8 A,B,C
integer*4 i,n
do i=2,n-1
s1 = (x(i-1)-x(i))*(x(i)**2-x(i+1)**2)
s2 = (x(i)-x(i+1))*(x(i-1)**2-x(i)**2)
r1 = (y(i-1)-y(i))*(x(i)-x(i+1))
r2 = (y(i)-y(i+1))*(x(i-1)-x(i))
r3 = (y(i-1)-y(i))*(x(i)**2-x(i+1)**2)
r4 = (y(i)-y(i+1))*(x(i-1)**2-x(i)**2)
A = (r1-r2)/(s2-s1)
B = (r3-r4)/(s1-s2)
C = y(i) - A*x(i)**2 - B*x(i)
dydx(i) = 2*A*x(i) + B
if(i.eq.2) dydx(i-1) = 2*A*x(i-1) + B
if(i.eq.(n-1)) dydx(i+1) = 2*A*x(i+1) + B
enddo
return
end
! --------------------------------------------------------
Subroutine derivation_Mikrom(n,x,y,dydx)
implicit none
real*8 x(100),y(100),dydx(100)
real*8 a1,A,B
integer*4 i,n
do i=2,n-1
a1 = (y(i)-y(i-1))/(x(i)-x(i-1))
A = ((y(i+1)-y(i))/(x(i+1)-x(i)) - a1)/(x(i+1)-x(i-1))
B = a1 - A*(x(i-1)+x(i))
dydx(i) = 2*A*x(i) + B
if(i.eq.2) dydx(i-1) = 2*A*x(i-1) + B
if(i.eq.(n-1)) dydx(i+1) = 2*A*x(i+1) + B
enddo
return
end
! --------------------------------------------------------
.000, .000, -.015, 1.005
.100, .200, .015, .995
.200, .400, .045, .980
.300, .600, .090, .950
.400, .800, .165, .915
.500, 1.000, .255, .880
.600, 1.200, .360, .825
.700, 1.400, .495, .760
.800, 1.600, .645, .695
.900, 1.800, .810, .620
1.000, 2.000, 1.005, .540
1.100, 2.200, 1.215, .455
1.200, 2.400, 1.440, .365
1.300, 2.600, 1.695, .265
1.400, 2.800, 1.965, .165
1.500, 3.000, 2.250, .075
1.600, 3.200, 2.565, -.025
1.700, 3.400, 2.895, -.130
1.800, 3.600, 3.240, -.230
1.900, 3.800, 3.615, -.325
2.000, 4.000, 4.005, -.415
YESgullipe said:I see that the subroutine call can be within a do-loop and then the subroutine would not contain any arrays nor a do-loop