| 
                Last change
                  on this file since 2551 was
                  135,
                  checked in by aslmd, 14 years ago
           | 
        
        
          | 
               
CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET 
 
           | 
        
        | 
            File size:
            894 bytes
           | 
      
      
        
  | Line |   | 
|---|
| 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.