Esope source files

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