[COLOR=#a020f0]program[/color] Lagrange_int
[COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
[COLOR=#0000ff]! A program that approximates a value of a function/experimental quantity [/color]
[COLOR=#0000ff]! at a point based on a given set of data[/color]
[COLOR=#0000ff]! number of data points:length of each data vector[/color]
[COLOR=#2e8b57][b]integer[/b][/color], [COLOR=#2e8b57][b]parameter[/b][/color] :: n [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]31[/color]
[COLOR=#0000ff]! vectors of known data: x,y-values[/color]
[COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color](n) :: x, y
[COLOR=#2e8b57][b]integer[/b][/color] :: i, pos, pn
[COLOR=#2e8b57][b]double precision[/b][/color] :: z, h, L
[COLOR=#0000ff]! Order of Interpolation Polynomial[/color]
pn [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]3[/color]
[COLOR=#0000ff]! The data[/color]
x [COLOR=#804040][b]=[/b][/color] ([COLOR=#804040][b]/[/b][/color][COLOR=#ff00ff]0.00[/color], [COLOR=#ff00ff]0.10[/color], [COLOR=#ff00ff]0.20[/color], [COLOR=#ff00ff]0.30[/color], [COLOR=#ff00ff]0.40[/color], [COLOR=#ff00ff]0.50[/color], [COLOR=#ff00ff]0.60[/color], [COLOR=#ff00ff]0.70[/color], [COLOR=#ff00ff]0.80[/color], [COLOR=#ff00ff]0.90[/color], [COLOR=#804040][b]&[/b][/color]
[COLOR=#ff00ff]1.00[/color], [COLOR=#ff00ff]1.10[/color], [COLOR=#ff00ff]1.20[/color], [COLOR=#ff00ff]1.30[/color], [COLOR=#ff00ff]1.40[/color], [COLOR=#ff00ff]1.50[/color], [COLOR=#ff00ff]1.60[/color], [COLOR=#ff00ff]1.70[/color], [COLOR=#ff00ff]1.80[/color], [COLOR=#ff00ff]1.90[/color], [COLOR=#804040][b]&[/b][/color]
[COLOR=#ff00ff]2.00[/color], [COLOR=#ff00ff]2.10[/color], [COLOR=#ff00ff]2.20[/color], [COLOR=#ff00ff]2.30[/color], [COLOR=#ff00ff]2.40[/color], [COLOR=#ff00ff]2.50[/color], [COLOR=#ff00ff]2.60[/color], [COLOR=#ff00ff]2.70[/color], [COLOR=#ff00ff]2.80[/color], [COLOR=#ff00ff]2.90[/color], [COLOR=#ff00ff]3.00[/color][COLOR=#804040][b]/[/b][/color])
y [COLOR=#804040][b]=[/b][/color] ([COLOR=#804040][b]/[/b][/color][COLOR=#ff00ff]0.00[/color], [COLOR=#ff00ff]0.29[/color], [COLOR=#ff00ff]0.56[/color], [COLOR=#ff00ff]0.81[/color], [COLOR=#ff00ff]1.04[/color], [COLOR=#ff00ff]1.25[/color], [COLOR=#ff00ff]1.44[/color], [COLOR=#ff00ff]1.61[/color], [COLOR=#ff00ff]1.76[/color], [COLOR=#ff00ff]1.89[/color], [COLOR=#804040][b]&[/b][/color]
[COLOR=#ff00ff]2.00[/color], [COLOR=#ff00ff]2.09[/color], [COLOR=#ff00ff]2.16[/color], [COLOR=#ff00ff]2.21[/color], [COLOR=#ff00ff]2.24[/color], [COLOR=#ff00ff]2.25[/color], [COLOR=#ff00ff]2.24[/color], [COLOR=#ff00ff]2.21[/color], [COLOR=#ff00ff]2.16[/color], [COLOR=#ff00ff]2.09[/color], [COLOR=#804040][b]&[/b][/color]
[COLOR=#ff00ff]2.00[/color], [COLOR=#ff00ff]1.89[/color], [COLOR=#ff00ff]1.76[/color], [COLOR=#ff00ff]1.61[/color], [COLOR=#ff00ff]1.44[/color], [COLOR=#ff00ff]1.25[/color], [COLOR=#ff00ff]1.04[/color], [COLOR=#ff00ff]0.81[/color], [COLOR=#ff00ff]0.56[/color], [COLOR=#ff00ff]0.29[/color], [COLOR=#ff00ff]0.00[/color][COLOR=#804040][b]/[/b][/color])
[COLOR=#804040][b]write[/b][/color] ([COLOR=#804040][b]*[/b][/color], [COLOR=#ff00ff]'(a3,2a10)'[/color]) [COLOR=#ff00ff]'i'[/color], [COLOR=#ff00ff]'x'[/color], [COLOR=#ff00ff]'y=f(x)'[/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]'(i3, f10.2 f10.2)'[/color]) i, x(i), y(i)
[COLOR=#804040][b]enddo[/b][/color]
[COLOR=#0000ff]! the point of evaluation[/color]
z [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]2.71[/color]
[COLOR=#0000ff]! find the position of z in array x[/color]
pos [COLOR=#804040][b]=[/b][/color] find_idx(x, z)
[COLOR=#0000ff]! call function Lagrange[/color]
[COLOR=#804040][b]if[/b][/color] (pos [COLOR=#804040][b]==[/b][/color] [COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]100[/color]) [COLOR=#804040][b]then[/b][/color]
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'Interpolation is not possible, data is out of range !'[/color]
[COLOR=#804040][b]goto[/b][/color] [COLOR=#ff00ff]99[/color]
[COLOR=#804040][b]else[/b][/color] [COLOR=#804040][b]if[/b][/color] (pos [COLOR=#804040][b]==[/b][/color] [COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]then[/b][/color]
L [COLOR=#804040][b]=[/b][/color] Lagrange(pn, x([COLOR=#ff00ff]1[/color]:pn[COLOR=#804040][b]+[/b][/color][COLOR=#ff00ff]1[/color]), y([COLOR=#ff00ff]1[/color]:pn[COLOR=#804040][b]+[/b][/color][COLOR=#ff00ff]1[/color]), z)
[COLOR=#804040][b]else[/b][/color] [COLOR=#804040][b]if[/b][/color] (pos [COLOR=#804040][b]==[/b][/color] n[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]then[/b][/color]
L [COLOR=#804040][b]=[/b][/color] Lagrange(pn, x(n[COLOR=#804040][b]-[/b][/color]pn:n), y(n[COLOR=#804040][b]-[/b][/color]pn:n), z)
[COLOR=#804040][b]else[/b][/color]
L [COLOR=#804040][b]=[/b][/color] Lagrange(pn, x(pos[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]:pos[COLOR=#804040][b]+[/b][/color]pn[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]), y(pos[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]:pos[COLOR=#804040][b]+[/b][/color]pn[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]), z)
[COLOR=#804040][b]end if[/b][/color]
[COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#ff00ff]10[/color]) z, L
[COLOR=#6a5acd]10[/color] [COLOR=#804040][b]format[/b][/color]([COLOR=#ff00ff]'The approximate value of y('[/color],[COLOR=#008080]f10.4[/color],[COLOR=#ff00ff]')='[/color],[COLOR=#008080]f10.4[/color])
[COLOR=#804040][b] 99 continue[/b][/color]
[COLOR=#0000ff]! end [/color]
[COLOR=#a020f0]contains[/color]
[COLOR=#2e8b57][b]double precision[/b][/color] [COLOR=#a020f0]function[/color] Lagrange(pn, xvect, yvect, z)
[COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
[COLOR=#0000ff]! Order of Interpolation Polynomial[/color]
[COLOR=#2e8b57][b]integer[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: pn
[COLOR=#0000ff]! vectors of known data: x,y-values[/color]
[COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color](:), [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: xvect, yvect
[COLOR=#0000ff]! the set evaluation point "z" [/color]
[COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: z
[COLOR=#2e8b57][b]integer[/b][/color] :: i, j, n
[COLOR=#0000ff]! Lagrange cardinal function[/color]
[COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color](pn[COLOR=#804040][b]+[/b][/color][COLOR=#ff00ff]1[/color]) :: L
[COLOR=#0000ff]! the value of the polynomial/function/quantity at that point[/color]
[COLOR=#2e8b57][b]double precision[/b][/color] :: Pz
[COLOR=#0000ff]! n = number of data points:length of each data vector[/color]
n [COLOR=#804040][b]=[/b][/color] [COLOR=#008080]size[/color](xvect)
[COLOR=#804040][b]if[/b][/color] (n [COLOR=#804040][b]/=[/b][/color] [COLOR=#008080]size[/color](yvect)) [COLOR=#804040][b]then[/b][/color]
[COLOR=#804040][b]write[/b][/color] ([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'Input Error !'[/color]
[COLOR=#804040][b]return[/b][/color]
[COLOR=#804040][b]end if[/b][/color]
[COLOR=#0000ff]! Initializations of Pz and L[/color]
Pz [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]0.0d0[/color] [COLOR=#0000ff]! initializing the polynomia value at z[/color]
L [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]1.0d0[/color] [COLOR=#0000ff]! initalizing the vector of cardinal functions to 1[/color]
[COLOR=#0000ff]! Performing the interpolation[/color]
[COLOR=#804040][b]do[/b][/color] i [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]1[/color], n
[COLOR=#804040][b]do[/b][/color] j [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]1[/color], n
[COLOR=#804040][b]if[/b][/color] (i [COLOR=#804040][b]/=[/b][/color] j) [COLOR=#804040][b]then[/b][/color]
[COLOR=#0000ff]! part of L(i)[/color]
L(i) [COLOR=#804040][b]=[/b][/color] ( (z [COLOR=#804040][b]-[/b][/color] xvect(j)) [COLOR=#804040][b]/[/b][/color] (xvect(i) [COLOR=#804040][b]-[/b][/color] xvect(j)) )[COLOR=#804040][b]*[/b][/color] L(i)
[COLOR=#804040][b]end if[/b][/color]
[COLOR=#804040][b]end do[/b][/color]
Pz [COLOR=#804040][b]=[/b][/color] Pz [COLOR=#804040][b]+[/b][/color] L(i)[COLOR=#804040][b]*[/b][/color]yvect(i) [COLOR=#0000ff]! update Pz ~ f(z)[/color]
[COLOR=#804040][b]end do[/b][/color]
[COLOR=#0000ff]! return value[/color]
Lagrange [COLOR=#804040][b]=[/b][/color] Pz
[COLOR=#a020f0]end function[/color] Lagrange
[COLOR=#2e8b57][b]integer[/b][/color] [COLOR=#a020f0]function[/color] find_idx(xvect, x)
[COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
[COLOR=#0000ff]! vector of x-values[/color]
[COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]dimension[/b][/color](:), [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: xvect
[COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x
[COLOR=#2e8b57][b]integer[/b][/color] :: i, k, n
[COLOR=#0000ff]! array dimension[/color]
n [COLOR=#804040][b]=[/b][/color] [COLOR=#008080]size[/color](xvect)
k [COLOR=#804040][b]=[/b][/color] [COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]100[/color] [COLOR=#0000ff]! k==-100 signals ERROR[/color]
[COLOR=#0000ff]! find index k so that x[k] < x < x[k+1][/color]
[COLOR=#804040][b]do[/b][/color] i [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]1[/color], n[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]
[COLOR=#804040][b]if[/b][/color] ((xvect(i) [COLOR=#804040][b]<=[/b][/color] x) [COLOR=#804040][b].and.[/b][/color] (x [COLOR=#804040][b]<=[/b][/color] xvect(i[COLOR=#804040][b]+[/b][/color][COLOR=#ff00ff]1[/color]))) [COLOR=#804040][b]then[/b][/color]
k [COLOR=#804040][b]=[/b][/color] i
[COLOR=#804040][b]exit[/b][/color]
[COLOR=#804040][b]end if[/b][/color]
[COLOR=#804040][b]end do[/b][/color]
find_idx [COLOR=#804040][b]=[/b][/color] k
[COLOR=#a020f0]end function[/color] find_idx
[COLOR=#a020f0]end program[/color] Lagrange_int