C INTE33 SOURCE CHAT 05/01/13 00:39:56 5004 SUBROUTINE INTE33(IPTG,IPGG,IPT,IPG) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) c c ===================================================== c = c recherche des ordonnees correspondant a une table = c d'abcisses donnee , par interpolation lineaire. = c = c creation : 03/06/87 = c programmeur : malaval = c = c ===================================================== c -INC SMLREEL c c abcisses connues de l'objet evolution c MLREEL=IPTG SEGACT MLREEL c c ordonnees connues de l'objet evolution c MLREE1=IPGG SEGACT MLREE1 c c abcisses dont on cherche les ordonnees dans l'objet evolution c MLREE2=IPT SEGACT MLREE2 c c ordonnees recherchees c LON1=MLREEL.PROG(/1) LON2=MLREE2.PROG(/1) JG=LON2 SEGINI MLREE3 IPG=MLREE3 N1=1 N2=LON1 c c interpolation lineaire c DO 13 I=1,LON2 TO=MLREE2.PROG(I) 11 CONTINUE N2N1=N2-N1 IF (N2N1.EQ.1) GOTO 12 NC=(N1+N2)/2 PRT=PROG(NC) IF (TO.LT.PRT) THEN N2=NC ELSE N1=NC ENDIF GOTO 11 12 CONTINUE PRT1=PROG(N1) PRT2=PROG(N2) ALPHA=(TO-PRT1)/(PRT2-PRT1) PRF1=MLREE1.PROG(N1) PRF2=MLREE1.PROG(N2) MLREE3.PROG(I)=ALPHA*(PRF2-PRF1)+PRF1 IF (TO .GT. PRT2) THEN c au dela de la définition de (iptg,ipgg) on extrapole à 0. MLREE3.PROG(I)=0.D0 ENDIF N2=LON1 13 CONTINUE c SEGDES MLREEL SEGDES MLREE1 SEGDES MLREE2 SEGDES MLREE3 RETURN END