C INTEPL    SOURCE    CHAT      05/01/13    00:40:11     5004
      SUBROUTINE INTEPL(YI,X,Y,N,XI,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C
C     IRET = 0  La valeur est dans l'intervalle (interpollation)
C     IRET = 1  La valeur est hors l'intervalle a droite
C     IRET =-1  La valeur est hors l'intervalle a gauche
C
      LOGICAL TIST
      REAL*8 X(N),Y(N)
      TIST(PI,I,J)=PI.GE.Y(I).AND.PI.LE.Y(J)
C
C COURBE CROISSANTE
      IF(Y(1).LT.Y(N))THEN

      IF(TIST(YI,1,N))THEN
      IRET=0

      DO 2 K=1,N-1
      IF(TIST(YI,K,K+1))THEN
      XI=X(K)+(X(K+1)-X(K))*(YI-Y(K))/(Y(K+1)-Y(K))
      RETURN
      ENDIF
 2    CONTINUE

      ELSEIF(YI.GT.Y(N))THEN
      XI=X(N)+(X(N-1)-X(N))*(YI-Y(N))/(Y(N-1)-Y(N))
C     WRITE(6,*)' Valeur a extrapoler plus grande que l''intervalle'
C     WRITE(6,1080)YI,Y(1),Y(N),XI
      IRET=1
      ELSE
      XI=X(1)+(X(2)-X(1))*(YI-Y(1))/(Y(2)-Y(1))
C     WRITE(6,*)' Valeur a extrapoler plus petite que l''intervalle'
C     WRITE(6,1080)YI,Y(1),Y(N),XI
      IRET=-1
      ENDIF
      RETURN


C COURBE DECROISSANTE
      ELSE

      IF(TIST(YI,N,1))THEN
      IRET=0

      DO 4 K=1,N-1
      IF(TIST(YI,K+1,K))THEN
      XI=X(K)+(X(K+1)-X(K))*(YI-Y(K))/(Y(K+1)-Y(K))
      RETURN
      ENDIF
 4    CONTINUE

      ELSEIF(YI.LT.Y(N))THEN
      XI=X(N)+(X(N-1)-X(N))*(YI-Y(N))/(Y(N-1)-Y(N))
C     WRITE(6,*)' Valeur a extrapoler plus petite que l''intervalle'
C     WRITE(6,1080)YI,Y(1),Y(N),XI
      IRET=1
      ELSE
      XI=X(1)+(X(2)-X(1))*(YI-Y(1))/(Y(2)-Y(1))
C     WRITE(6,*)' Valeur a extrapoler plus grande que l''intervalle'
C     WRITE(6,1080)YI,Y(1),Y(N),XI
      IRET=-1
      ENDIF
      RETURN

      ENDIF
 1080 FORMAT(' YI=',1PE11.4,' Y(1)=',1PE11.4,' Y(N)=',1PE11.4,' XI=',
     &1PE11.4)
      END