Télécharger la plaquette Cast3M


fr en

Télécharger inter2.eso

Retour à la liste

Numérotation des lignes : 

inter2

  1. C INTER2    SOURCE    CB215821  18/12/04    21:15:29     10020          
  2.       SUBROUTINE INTER2(TEMPS,KTE,KFT,LON,FT0,IRET)
  3. C
  4. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc
  5. C
  6. C   INTERPOLATION LINEAIRE
  7. C
  8. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc
  9. C
  10. C  Rem :
  11. C    donne la première valeur si TEMPS=KTE(1) même si KTE(2)=KTE(1)
  12. C    donne la dernière valeur si TEMPS=KTE(LON) même si KTE(LON-1)=KTE(LON)
  13. C
  14. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc
  15. C
  16. C  TEMPS  : valeur où interpoler la fonction
  17. C  KTE    : abscisses de la fonction à interpoler
  18. C  KFT    : ordonnées de la fonction à interpoler
  19. C  LON    : longueur de ces deux précédentes listes
  20. C  FT0    : valeur interpolée de la fonction à l'abscisse TEMPS
  21. C  IRET   : code retour =1 si succès, 0 sinon
  22. C
  23. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc
  24. C
  25. C  HISTORIQUE :
  26. C
  27. C   14/9/90 PP
  28. C       tenant compte du fait que l'on compare des reels....
  29. C
  30. c    4/9/91
  31. C       tj valable apres release 91
  32. C
  33. C  22/08/06 P. Maugis
  34. C     . remplacement de 1.D-5*DT par XZPREC
  35. C     . accepte les cas d'abscisses non strictement croissantes
  36. C     . accepte des valeurs en dehors de l'intervalle de définition
  37. C         à XZPREC près ;
  38. C         donne alors la première (ou la dernière) valeur dans la liste.
  39. C
  40. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc
  41.  
  42.       IMPLICIT INTEGER(I-N)
  43.       IMPLICIT REAL*8(A-H,O-Z)
  44.  
  45. -INC SMLREEL
  46.  
  47. -INC PPARAM
  48. -INC CCOPTIO
  49. -INC CCREEL
  50.  
  51.       FT0=0
  52.       MLREE1=KTE
  53.       MLREE2=KFT
  54. C PEG T1=MLREE1.PROG(1)
  55. C PEG L1=1
  56. C PEG IF(TEMPS.LT.T1) GOTO 50
  57.       T2=MLREE1.PROG(1)
  58.       L2=1
  59.       DT=MLREE1.PROG(2)-T2
  60.  
  61. *     test si valeur inférieure ou égale à la première de la liste
  62.       IF(TEMPS.LT. T2) TEMPS=T2
  63.  
  64.       IF (TEMPS.LE.T2) THEN
  65.         FT0=MLREE2.PROG(L2)
  66.         IRET=1
  67.         RETURN
  68.       ENDIF
  69.  
  70.  
  71.       DO L=2,LON
  73.         L1=L2
  74.         T2=MLREE1.PROG(L)
  75.         L2=L
  76. *       la liste est bien croissante ?
  77.         IF(T1.GT.T2) GOTO 55
  78. *       a-t-on encadré l'abscisse fournie ? noter la comparaison stricte
  79.         IF(TEMPS.LT.T2) GOTO 60
  80. C PEG   T1=T2
  81. C PEG   L1=L2
  82.       ENDDO
  83.  
  84. *     La valeur est supérieure ou égale à la dernière de la liste
  85.       IF(TEMPS.GT.T2) TEMPS=T2
  86.  
  87. *PM   On donne la dernière valeur de la liste
  88.       FT0=MLREE2.PROG(L2)
  89.       IRET=1
  90.       RETURN
  91.  
  92. *     On interpole linéairement la fonction
  93.  60   CONTINUE
  94.       DT=(TEMPS-T1)/(T2-T1)
  95.       FT1=MLREE2.PROG(L1)
  96.       FT2=MLREE2.PROG(L2)
  97.       FT0=(FT2-FT1)*DT+FT1
  98.  
  99.  70   IRET=1
  100.       RETURN
  101.  
  102. *     "Valeur en dehors de la table"
  103.  50   CONTINUE
  104.       CALL ERREUR(210)
  105.       IRET=0
  106.       RETURN
  107.  
  108. C     Temps non croissants dans la liste
  109. C     "La suite de réels doit être croissante"
  110.    55 CALL ERREUR(249)
  111.       IRET=0
  112.  
  113.       END
  114.  
  115.  

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