Télécharger la plaquette Cast3M


fr en

Télécharger intepl.eso

Retour à la liste

Numérotation des lignes : 

intepl

  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