Esope source files

   1 : C INTER2    SOURCE    MAUGIS    07/03/19    21:15:01     5690           
   2 :       SUBROUTINE INTER2(TEMPS,KTE,KFT,LON,FT0,IRET)
   3 : C
   4 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc
   5 : C
   6 : C   INTERPOLATION LINEAIRE    
   7 : C
   8 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc
   9 : C
  10 : C  Rem : 
  11 : C    donne la première valeur si TEMPS=KTE(1) même si KTE(2)=KTE(1)
  12 : C    donne la dernière valeur si TEMPS=KTE(LON) même si KTE(LON-1)=KTE(LON)
  13 : C
  14 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc
  15 : C
  16 : C  TEMPS  : valeur où interpoler la fonction
  17 : C  KTE    : abscisses de la fonction à interpoler
  18 : C  KFT    : ordonnées de la fonction à interpoler 
  19 : C  LON    : longueur de ces deux précédentes listes
  20 : C  FT0    : valeur interpolée de la fonction à l'abscisse TEMPS
  21 : C  IRET   : code retour =1 si succès, 0 sinon
  22 : C
  23 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc
  24 : C
  25 : C  HISTORIQUE :
  26 : C
  27 : C   14/9/90 PP 
  28 : C       tenant compte du fait que l'on compare des reels....
  29 : C
  30 : c    4/9/91 
  31 : C       tj valable apres release 91
  32 : C
  33 : C  22/08/06 P. Maugis 
  34 : C     . remplacement de 1.D-5*DT par XZPREC
  35 : C     . accepte les cas d'abscisses non strictement croissantes
  36 : C     . accepte des valeurs en dehors de l'intervalle de définition
  37 : C         à XZPREC près ;
  38 : C         donne alors la première (ou la dernière) valeur dans la liste.
  39 : C
  40 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc
  41 : 
  42 :       IMPLICIT INTEGER(I-N)
  43 :       IMPLICIT REAL*8(A-H,O-Z)
  44 : 
  45 : -INC SMLREEL
  46 : -INC CCOPTIO
  47 : -INC CCREEL
  48 : 
  49 :       FT0=0
  50 :       MLREE1=KTE
  51 :       MLREE2=KFT
  52 : C PEG T1=MLREE1.PROG(1)
  53 : C PEG L1=1
  54 : C PEG IF(TEMPS.LT.T1) GOTO 50
  55 :       T2=MLREE1.PROG(1)
  56 :       L2=1
  57 :       DT=MLREE1.PROG(2)-T2
  58 : 
  59 : *     test si valeur inférieure ou égale à la première de la liste
  60 : *PM   IF (TEMPS.LT.T2) THEN
  61 :       IF(TEMPS.LT.(T2-XZPREC)) GOTO 50
  62 : 
  63 :       IF (TEMPS.LE.T2) THEN
  64 :         FT0=MLREE2.PROG(L2)
  65 :         IRET=1
  66 :         RETURN
  67 :       ENDIF
  68 : 
  69 : 
  70 :       DO L=2,LON
  71 :         T1=T2
  72 :         L1=L2
  73 :         T2=MLREE1.PROG(L)
  74 :         L2=L
  75 : *       la liste est bien croissante ?
  76 :         IF(T1.GT.T2) GOTO 55
  77 : *       a-t-on encadré l'abscisse fournie ? noter la comparaison stricte
  78 :         IF(TEMPS.LT.T2) GOTO 60
  79 : C PEG   T1=T2
  80 : C PEG   L1=L2
  81 :       ENDDO
  82 : 
  83 : *     La valeur est supérieure ou égale à la dernière de la liste
  84 :       IF(TEMPS.GT.(T2+XZPREC)) GOTO 50
  85 : 
  86 : *PM   On donne la dernière valeur de la liste
  87 :       FT0=MLREE2.PROG(L2)
  88 :       IRET=1
  89 :       RETURN
  90 : 
  91 : *     On interpole linéairement la fonction
  92 :  60   CONTINUE 
  93 :       DT=(TEMPS-T1)/(T2-T1)
  94 :       FT1=MLREE2.PROG(L1)
  95 :       FT2=MLREE2.PROG(L2)
  96 :       FT0=(FT2-FT1)*DT+FT1
  97 : 
  98 :  70   IRET=1
  99 :       RETURN
 100 : 
 101 : *     "Valeur en dehors de la table"
 102 :  50   CONTINUE
 102 :       CALL ERREUR(210)
 103 :       IRET=0
 104 :       RETURN
 105 : 
 106 : C     Temps non croissants dans la liste
 107 : C     "La suite de réels doit être croissante"
 107 :    55 CALL ERREUR(249)
 108 :       IRET=0
 109 :       RETURN
 110 : 
 111 :       END
 112 :  
 113 :