Télécharger inter5.eso

Retour à la liste

Numérotation des lignes :

  1. C INTER5 SOURCE GOUNAND 12/09/10 21:15:02 7495
  2. SUBROUTINE INTER5(TEMPS,KTE,KFT,FT0,ISPLIN,
  3. $ MLDERS,IVERI,IRET)
  4. C
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C INTERPOLATION LINEAIRE ; recherche par binary search
  8. C Source : Donald Knuth, The Art of Computer Programming
  9. C Volume 3, Sorting and searching, Third edition, 1997
  10. C Addison-Wesley pp. 409-426
  11. C
  12. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  13. C
  14. C TEMPS : valeur où interpoler la fonction
  15. C KTE : abscisses de la fonction à interpoler
  16. C KFT : ordonnées de la fonction à interpoler
  17. C LON : longueur de ces deux précédentes listes
  18. C FT0 : valeur interpolée de la fonction à l'abscisse TEMPS
  19. C ISENS : =0 KTE est croissante =1 KTE est décroissante
  20. C IVERI : =0 ne renvoie pas d'erreur si t est en-dehors des bornes
  21. C mais la valeur de la fonction pour t le plus proche
  22. C =1 renvoie une erreur si t est en-dehors des bornes
  23. C IRET : code retour =1 si succès, 0 sinon
  24. C
  25. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8(A-H,O-Z)
  28. -INC SMLREEL
  29. POINTEUR MLDERS.MLREEL
  30. -INC CCOPTIO
  31. -INC CCREEL
  32. *
  33. FT0=0.D0
  34. MLREE1=KTE
  35. MLREE2=KFT
  36. LON=MLREE1.PROG(/1)
  37. * Cas de bord (bourrin)
  38. TINF=MLREE1.PROG(1)
  39. TSUP=MLREE1.PROG(LON)
  40. C WRITE(IOIMP,*) 'IVERI=',IVERI
  41. C WRITE(IOIMP,*) 'ISENS=',ISENS
  42. C WRITE(IOIMP,*) 'TINF=',TINF
  43. C WRITE(IOIMP,*) 'TSUP=',TSUP
  44. IF (IVERI.EQ.1) THEN
  45. IF (TEMPS.LT.TINF) THEN
  46. GOTO 50
  47. ELSEIF (TEMPS.GT.TSUP) THEN
  48. GOTO 50
  49. ENDIF
  50. ENDIF
  51. IF (TEMPS.LE.TINF) THEN
  52. FT0=MLREE2.PROG(1)
  53. GOTO 70
  54. ELSEIF (TEMPS.GE.TSUP) THEN
  55. FT0=MLREE2.PROG(LON)
  56. GOTO 70
  57. ENDIF
  58. * Recherche de l'index
  59. IDXINF=1
  60. IDXSUP=LON
  61. 1 CONTINUE
  62. C WRITE(IOIMP,*) 'IDXINF=',IDXINF
  63. C WRITE(IOIMP,*) 'IDXSUP=',IDXSUP
  64. IF (IDXSUP.LT.IDXINF) GOTO 3
  65. IDXMIL=(IDXINF+IDXSUP)/2
  66. TEMMIL=MLREE1.PROG(IDXMIL)
  67. C WRITE(IOIMP,*) 'IDXMIL=',IDXMIL
  68. C WRITE(IOIMP,*) 'TEMMIL=',TEMMIL
  69. IF (TEMPS.LT.TEMMIL) THEN
  70. IDXSUP=IDXMIL-1
  71. GOTO 1
  72. ELSEIF (TEMPS.GT.TEMMIL) THEN
  73. IDXINF=IDXMIL+1
  74. GOTO 1
  75. ELSE
  76. FT0=MLREE2.PROG(IDXMIL)
  77. GOTO 70
  78. ENDIF
  79. 3 CONTINUE
  80. T1=MLREE1.PROG(IDXINF)
  81. T2=MLREE1.PROG(IDXSUP)
  82. DT=T2-T1
  83. XP2=(TEMPS-T1)/DT
  84. XP1=(T2-TEMPS)/DT
  85. FT1=MLREE2.PROG(IDXINF)
  86. FT2=MLREE2.PROG(IDXSUP)
  87. IF (ISPLIN.EQ.1) THEN
  88. DSFT1=MLDERS.PROG(IDXINF)
  89. DSFT2=MLDERS.PROG(IDXSUP)
  90. FT0=XP1*FT1+XP2*FT2+((XP1**3-XP1)*DSFT1+(XP2**3-XP2)*DSFT2)
  91. $ *(DT**2)/6.D0
  92. ELSE
  93. FT0=(XP1*FT1)+(XP2*FT2)
  94. ENDIF
  95. 70 CONTINUE
  96. IRET=1
  97. RETURN
  98. * "Valeur en dehors de la table"
  99. 50 CONTINUE
  100. CALL ERREUR(210)
  101. IRET=0
  102. RETURN
  103. END
  104.  
  105.  
  106.  
  107.  
  108.  

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