Télécharger intepl.eso

Retour à la liste

Numérotation des lignes :

  1. C INTEPL SOURCE CHAT 05/01/13 00:40:11 5004
  2. SUBROUTINE INTEPL(YI,X,Y,N,XI,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C
  6. C IRET = 0 La valeur est dans l'intervalle (interpollation)
  7. C IRET = 1 La valeur est hors l'intervalle a droite
  8. C IRET =-1 La valeur est hors l'intervalle a gauche
  9. C
  10. LOGICAL TIST
  11. REAL*8 X(N),Y(N)
  12. TIST(PI,I,J)=PI.GE.Y(I).AND.PI.LE.Y(J)
  13. C
  14. C COURBE CROISSANTE
  15. IF(Y(1).LT.Y(N))THEN
  16.  
  17. IF(TIST(YI,1,N))THEN
  18. IRET=0
  19.  
  20. DO 2 K=1,N-1
  21. IF(TIST(YI,K,K+1))THEN
  22. XI=X(K)+(X(K+1)-X(K))*(YI-Y(K))/(Y(K+1)-Y(K))
  23. RETURN
  24. ENDIF
  25. 2 CONTINUE
  26.  
  27. ELSEIF(YI.GT.Y(N))THEN
  28. XI=X(N)+(X(N-1)-X(N))*(YI-Y(N))/(Y(N-1)-Y(N))
  29. C WRITE(6,*)' Valeur a extrapoler plus grande que l''intervalle'
  30. C WRITE(6,1080)YI,Y(1),Y(N),XI
  31. IRET=1
  32. ELSE
  33. XI=X(1)+(X(2)-X(1))*(YI-Y(1))/(Y(2)-Y(1))
  34. C WRITE(6,*)' Valeur a extrapoler plus petite que l''intervalle'
  35. C WRITE(6,1080)YI,Y(1),Y(N),XI
  36. IRET=-1
  37. ENDIF
  38. RETURN
  39.  
  40.  
  41. C COURBE DECROISSANTE
  42. ELSE
  43.  
  44. IF(TIST(YI,N,1))THEN
  45. IRET=0
  46.  
  47. DO 4 K=1,N-1
  48. IF(TIST(YI,K+1,K))THEN
  49. XI=X(K)+(X(K+1)-X(K))*(YI-Y(K))/(Y(K+1)-Y(K))
  50. RETURN
  51. ENDIF
  52. 4 CONTINUE
  53.  
  54. ELSEIF(YI.LT.Y(N))THEN
  55. XI=X(N)+(X(N-1)-X(N))*(YI-Y(N))/(Y(N-1)-Y(N))
  56. C WRITE(6,*)' Valeur a extrapoler plus petite que l''intervalle'
  57. C WRITE(6,1080)YI,Y(1),Y(N),XI
  58. IRET=1
  59. ELSE
  60. XI=X(1)+(X(2)-X(1))*(YI-Y(1))/(Y(2)-Y(1))
  61. C WRITE(6,*)' Valeur a extrapoler plus grande que l''intervalle'
  62. C WRITE(6,1080)YI,Y(1),Y(N),XI
  63. IRET=-1
  64. ENDIF
  65. RETURN
  66.  
  67. ENDIF
  68. 1080 FORMAT(' YI=',1PE11.4,' Y(1)=',1PE11.4,' Y(N)=',1PE11.4,' XI=',
  69. &1PE11.4)
  70. END
  71.  
  72.  

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