Télécharger la plaquette Cast3M


fr en

Télécharger intlin.eso

Retour à la liste

Numérotation des lignes : 

intlin

  1. C INTLIN    SOURCE    BP208322  20/06/16    21:15:05     10627          
  2.       SUBROUTINE INTLIN(TEMPS,KTE,KFT,LON,L1,L2,FT0,IRET)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     INTERPOLATION LINEAIRE D'UNE VALEUR                            *
  8. *                                                                    *
  9. *     Parametres:                                                    *
  10. *                                                                    *
  11. *  e  TEMPS   Abscisse a interpoler                                  *
  12. *  e  KTE     LISTREEL des abscisses triees par ordre croissant      *
  13. *  e  KFT     LISTREEL des ordonnees                                 *
  14. *  e  LON     Longueur de la LISTREEL des abscisses                  *
  15. *  e/s L1     indice de debut de recherche dans les abscisses        *
  16. *  e/s L2     = L1+1 (a priori toujours vrai)                        *
  17. *  s  FT0     Valeur interpolee                                      *
  18. *  s  IRET    IRET = 1, succes                                       *
  19. *  s  IRET    IRET = 0, echec                                        *
  20. *                                                                    *
  21. *--------------------------------------------------------------------*
  22. -INC SMLREEL
  23.  
  24.       FT0 = 0.D0
  25.       MLREE1 = KTE
  26.       MLREE2 = KFT
  27.       T1 = MLREE1.PROG(L1)
  28.       TL = MLREE1.PROG(LON) 
  29.  
  30. c *     verif temporaire
  31. c       if(L1.GE.LON) then
  32. c         write(*,*) 'impossible d interpoler entre ',L1,' et ',LON
  33. c         IRET = 0
  34. c         return
  35. c       endif
  36.  
  37. *     temps en dehors de la liste ?
  38.       IF (TEMPS.LE.T1 .OR. TEMPS.GE.TL) THEN
  39. *        tentative de rattrapage (bp,2020)
  40. *        bp: d'apres mesure sur 1 cas (a faire evoluer si besoin),
  41. *            la tolerance de 1D-5 devrait assurer le test sur 
  42. *            l'erreur cumulee jusqu'a environ 1E7 pas de temps
  43. *            (on suppose que le pas de temps ne varie pas trop)
  44.          TOL=1.D-5*(TL-T1)/DBLE(LON - L1)
  45.          IF (ABS(TEMPS-T1).LT.TOL) THEN
  46.            FT0=MLREE2.PROG(L1)
  47.            IRET = 1
  48. c            write(*,*) 't=',TEMPS,'~',T1,'on prend PROG(',L1,')=',FT0
  49.          ELSEIF (ABS(TEMPS-TL).LT.TOL) THEN
  50.            FT0=MLREE2.PROG(LON)
  51.            IRET = 1
  52. c            write(*,*) 't=',TEMPS,'~',TL,'on prend PROG(',LON,')=',FT0
  53.          ELSE
  54. *          temps en dehors de la liste
  55. c            write(*,*) 't=',TEMPS,'out of [',T1,' - ',TL,'] !!!'   
  56.            IRET = 0
  57.          ENDIF
  58.          RETURN
  59.       ENDIF
  60.  
  61. *     recherche dans la liste      
  62.       DO 10 L = L2,LON
  63.          T2 = MLREE1.PROG(L)
  64.          L2 = L
  65.          IF (TEMPS.LT.T2) GOTO 20
  66.          T1 = T2
  67.          L1 = L2
  68.  10   CONTINUE
  69.  
  70. *     interpolation lineaire
  71.  20   CONTINUE 
  72.       FT1 = MLREE2.PROG(L1)
  73.       FT2 = MLREE2.PROG(L2)
  74.       DT = (TEMPS - T1) / (T2 - T1)
  75.       FT0 = (FT2 - FT1) * DT + FT1
  76.       IRET = 1
  77. *
  78.       END
  79.  
  80.  
  81.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales