|
Last change
on this file since 146 was
135,
checked in by aslmd, 14 years ago
|
|
CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET
|
|
File size:
894 bytes
|
| Rev | Line | |
|---|
| [135] | 1 | subroutine lagrange(x, xi, yi, ans) |
|---|
| 2 | |
|---|
| 3 | C Lagrange interpolation - Polynomial interpolation at point x |
|---|
| 4 | C xi(1) <= x <= xi(4). Yi(n) is the functional value at XI(n). |
|---|
| 5 | |
|---|
| 6 | implicit none |
|---|
| 7 | |
|---|
| 8 | real*8 x, xi(4), yi(4), ans |
|---|
| 9 | real*8 fm1, fm2, fm3, fm4 |
|---|
| 10 | |
|---|
| 11 | C======================================================================! |
|---|
| 12 | |
|---|
| 13 | fm1 = x - XI(1) |
|---|
| 14 | fm2 = x - XI(2) |
|---|
| 15 | fm3 = x - XI(3) |
|---|
| 16 | fm4 = x - XI(4) |
|---|
| 17 | |
|---|
| 18 | C Get the answer at the requested X |
|---|
| 19 | |
|---|
| 20 | ans = fm2*fm3*fm4*YI(1)/ |
|---|
| 21 | * ((XI(1)-XI(2))*(XI(1)-XI(3))*(XI(1)-XI(4))) + |
|---|
| 22 | * fm1*fm3*fm4*YI(2)/ |
|---|
| 23 | * ((XI(2)-XI(1))*(XI(2)-XI(3))*(XI(2)-XI(4))) + |
|---|
| 24 | * fm1*fm2*fm4*YI(3)/ |
|---|
| 25 | * ((XI(3)-XI(1))*(XI(3)-XI(2))*(XI(3)-XI(4))) + |
|---|
| 26 | * fm1*fm2*fm3*YI(4)/ |
|---|
| 27 | * ((XI(4)-XI(1))*(XI(4)-XI(2))*(XI(4)-XI(3))) |
|---|
| 28 | |
|---|
| 29 | return |
|---|
| 30 | end |
|---|
Note: See
TracBrowser
for help on using the repository browser.
