Esope source files

   1 : C INTER4    SOURCE    GOUNAND   07/09/07    21:15:10     5842           
   2 :       SUBROUTINE INTER4(TEMPS,KTE,KFT,LON,FT0,ISENS,IVERI,IRET)
   3 : C
   4 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   5 : C
   6 : C   INTERPOLATION LINEAIRE ; recherche par binary search
   7 : C   Source : Donald Knuth, The Art of Computer Programming
   8 : C   Volume 3, Sorting and searching, Third edition, 1997
   9 : C   Addison-Wesley pp. 409-426
  10 : C
  11 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  12 : C
  13 : C  TEMPS  : valeur où interpoler la fonction
  14 : C  KTE    : abscisses de la fonction à interpoler
  15 : C  KFT    : ordonnées de la fonction à interpoler 
  16 : C  LON    : longueur de ces deux précédentes listes
  17 : C  FT0    : valeur interpolée de la fonction à l'abscisse TEMPS
  18 : C  ISENS  : =0 KTE est croissante =1 KTE est décroissante
  19 : C  IVERI  : =0 ne renvoie pas d'erreur si t est en-dehors des bornes 
  20 : C              mais la valeur de la fonction pour t le plus proche
  21 : C           =1 renvoie  une erreur si t est en-dehors des bornes 
  22 : C  IRET   : code retour =1 si succès, 0 sinon 
  23 : C
  24 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  25 :       IMPLICIT INTEGER(I-N)
  26 :       IMPLICIT REAL*8(A-H,O-Z)
  27 : -INC SMLREEL
  28 : -INC CCOPTIO
  29 : -INC CCREEL
  30 : *
  31 :       FT0=0.D0
  32 :       MLREE1=KTE
  33 :       MLREE2=KFT
  34 : * Cas de bord (bourrin)
  35 :       TINF=MLREE1.PROG(1)
  36 :       TSUP=MLREE1.PROG(LON)
  37 : C      WRITE(IOIMP,*) 'IVERI=',IVERI
  38 : C      WRITE(IOIMP,*) 'ISENS=',ISENS
  39 : C      WRITE(IOIMP,*) 'TINF=',TINF
  40 : C      WRITE(IOIMP,*) 'TSUP=',TSUP
  41 :       IF (ISENS.EQ.0) THEN
  42 :          IF (IVERI.EQ.1) THEN
  43 :             IF (TEMPS.LT.TINF) THEN
  44 :                GOTO 50 
  45 :             ELSEIF (TEMPS.GT.TSUP) THEN
  46 :                GOTO 50
  47 :             ENDIF
  48 :          ENDIF
  49 :          IF (TEMPS.LE.TINF) THEN
  50 :             FT0=MLREE2.PROG(1)
  51 :             GOTO 70 
  52 :          ELSEIF (TEMPS.GE.TSUP) THEN
  53 :             FT0=MLREE2.PROG(LON)
  54 :             GOTO 70
  55 :          ENDIF
  56 :       ELSE
  57 :          IF (IVERI.EQ.1) THEN
  58 :             IF (TEMPS.GT.TINF) THEN
  59 :                GOTO 50
  60 :             ELSEIF (TEMPS.LT.TSUP) THEN
  61 :                GOTO 50
  62 :             ENDIF
  63 :          ENDIF
  64 :          IF (TEMPS.GE.TINF) THEN
  65 :             FT0=MLREE2.PROG(1)
  66 :             GOTO 70
  67 :          ELSEIF (TEMPS.LE.TSUP) THEN
  68 :             FT0=MLREE2.PROG(LON)
  69 :             GOTO 70
  70 :          ENDIF
  71 :       ENDIF
  72 : * Recherche de l'index
  73 :       IDXINF=1
  74 :       IDXSUP=LON
  75 :       IF (ISENS.EQ.0) THEN
  76 :  1       CONTINUE
  77 : C         WRITE(IOIMP,*) 'IDXINF=',IDXINF
  78 : C         WRITE(IOIMP,*) 'IDXSUP=',IDXSUP
  79 :          IF (IDXSUP.LT.IDXINF) GOTO 3
  80 :          IDXMIL=(IDXINF+IDXSUP)/2
  81 :          TEMMIL=MLREE1.PROG(IDXMIL)
  82 : C         WRITE(IOIMP,*) 'IDXMIL=',IDXMIL
  83 : C         WRITE(IOIMP,*) 'TEMMIL=',TEMMIL
  84 :          IF (TEMPS.LT.TEMMIL) THEN
  85 :             IDXSUP=IDXMIL-1
  86 :             GOTO 1
  87 :          ELSEIF (TEMPS.GT.TEMMIL) THEN
  88 :             IDXINF=IDXMIL+1
  89 :             GOTO 1
  90 :          ELSE
  91 :             FT0=MLREE2.PROG(IDXMIL)
  92 :             GOTO 70
  93 :          ENDIF
  94 :       ELSE
  95 :  2       CONTINUE
  96 : C         WRITE(IOIMP,*) 'IDXINF=',IDXINF
  97 : C         WRITE(IOIMP,*) 'IDXSUP=',IDXSUP
  98 :          IF (IDXSUP.LT.IDXINF) GOTO 3
  99 :          IDXMIL=(IDXINF+IDXSUP)/2
 100 :          TEMMIL=MLREE1.PROG(IDXMIL)
 101 : C         WRITE(IOIMP,*) 'IDXMIL=',IDXMIL
 102 : C         WRITE(IOIMP,*) 'TEMMIL=',TEMMIL
 103 :          IF (TEMPS.GT.TEMMIL) THEN
 104 :             IDXSUP=IDXMIL-1
 105 :             GOTO 2
 106 :          ELSEIF (TEMPS.LT.TEMMIL) THEN
 107 :             IDXINF=IDXMIL+1
 108 :             GOTO 2
 109 :          ELSE
 110 :             FT0=MLREE2.PROG(IDXMIL)
 111 :             GOTO 70
 112 :          ENDIF
 113 :       ENDIF
 114 :  3    CONTINUE
 115 :       T1=MLREE1.PROG(IDXSUP)
 116 :       T2=MLREE1.PROG(IDXINF)
 117 :       XP2=(TEMPS-T1)/(T2-T1)
 118 :       XP1=(T2-TEMPS)/(T2-T1)
 119 :       FT1=MLREE2.PROG(IDXSUP)
 120 :       FT2=MLREE2.PROG(IDXINF)
 121 :       FT0=(XP1*FT1)+(XP2*FT2)
 122 :  70   CONTINUE
 123 :       IRET=1
 124 :       RETURN
 125 : *     "Valeur en dehors de la table"
 126 :  50   CONTINUE
 126 :       CALL ERREUR(210)
 127 :       IRET=0
 128 :       RETURN
 129 :       END
 130 :  
 131 :  
 132 :