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 :
© Cast3M 2003 - All rights reserved.
Disclaimer