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
  72. L1=L2
  73. T2=MLREE1.PROG(L)
  74. L2=L
  75. * la liste est bien croissante ?
  76. IF(T1.GT.T2) GOTO 55
  77. * a-t-on encadré l'abscisse fournie ? noter la comparaison stricte
  78. IF(TEMPS.LT.T2) GOTO 60
  79. C PEG T1=T2
  80. C PEG L1=L2
  81. ENDDO
  82.  
  83. * La valeur est supérieure ou égale à la dernière de la liste
  84. IF(TEMPS.GT.T2) TEMPS=T2
  85.  
  86. *PM On donne la dernière valeur de la liste
  87. FT0=MLREE2.PROG(L2)
  88. IRET=1
  89. RETURN
  90.  
  91. * On interpole linéairement la fonction
  92. 60 CONTINUE
  93. DT=(TEMPS-T1)/(T2-T1)
  94. FT1=MLREE2.PROG(L1)
  95. FT2=MLREE2.PROG(L2)
  96. FT0=(FT2-FT1)*DT+FT1
  97.  
  98. 70 IRET=1
  99. RETURN
  100.  
  101. * "Valeur en dehors de la table"
  102. 50 CONTINUE
  103. CALL ERREUR(210)
  104. IRET=0
  105. RETURN
  106.  
  107. C Temps non croissants dans la liste
  108. C "La suite de réels doit être croissante"
  109. 55 CALL ERREUR(249)
  110. IRET=0
  111.  
  112. END
  113.  
  114.  

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