Télécharger inter2.eso

Retour à la liste

Numérotation des lignes :

  1. C INTER2 SOURCE MAUGIS 07/03/19 21:15:01 5690
  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. -INC CCOPTIO
  47. -INC CCREEL
  48.  
  49. FT0=0
  50. MLREE1=KTE
  51. MLREE2=KFT
  52. C PEG T1=MLREE1.PROG(1)
  53. C PEG L1=1
  54. C PEG IF(TEMPS.LT.T1) GOTO 50
  55. T2=MLREE1.PROG(1)
  56. L2=1
  57. DT=MLREE1.PROG(2)-T2
  58.  
  59. * test si valeur inférieure ou égale à la première de la liste
  60. *PM IF (TEMPS.LT.T2) THEN
  61. IF(TEMPS.LT.(T2-XZPREC)) GOTO 50
  62.  
  63. IF (TEMPS.LE.T2) THEN
  64. FT0=MLREE2.PROG(L2)
  65. IRET=1
  66. RETURN
  67. ENDIF
  68.  
  69.  
  70. DO L=2,LON
  71. L1=L2
  72. T2=MLREE1.PROG(L)
  73. L2=L
  74. * la liste est bien croissante ?
  75. IF(T1.GT.T2) GOTO 55
  76. * a-t-on encadré l'abscisse fournie ? noter la comparaison stricte
  77. IF(TEMPS.LT.T2) GOTO 60
  78. C PEG T1=T2
  79. C PEG L1=L2
  80. ENDDO
  81.  
  82. * La valeur est supérieure ou égale à la dernière de la liste
  83. IF(TEMPS.GT.(T2+XZPREC)) GOTO 50
  84.  
  85. *PM On donne la dernière valeur de la liste
  86. FT0=MLREE2.PROG(L2)
  87. IRET=1
  88. RETURN
  89.  
  90. * On interpole linéairement la fonction
  91. 60 CONTINUE
  92. DT=(TEMPS-T1)/(T2-T1)
  93. FT1=MLREE2.PROG(L1)
  94. FT2=MLREE2.PROG(L2)
  95. FT0=(FT2-FT1)*DT+FT1
  96.  
  97. 70 IRET=1
  98. RETURN
  99.  
  100. * "Valeur en dehors de la table"
  101. 50 CONTINUE
  102. CALL ERREUR(210)
  103. IRET=0
  104. RETURN
  105.  
  106. C Temps non croissants dans la liste
  107. C "La suite de réels doit être croissante"
  108. 55 CALL ERREUR(249)
  109. IRET=0
  110. RETURN
  111.  
  112. END
  113.  
  114.  
  115.  

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