Esope source files

   1 : C INTE33    SOURCE    CHAT      05/01/13    00:39:56     5004           
   2 :       SUBROUTINE INTE33(IPTG,IPGG,IPT,IPG)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : c
   6 : c     =====================================================
   7 : c                                                         =
   8 : c     recherche des ordonnees correspondant a une table   =
   9 : c     d'abcisses donnee , par interpolation lineaire.     =
  10 : c                                                         =
  11 : c     creation : 03/06/87                                 =
  12 : c     programmeur : malaval                               =
  13 : c                                                         =
  14 : c     =====================================================
  15 : c
  16 : -INC SMLREEL
  17 : c
  18 : c     abcisses connues de  l'objet evolution
  19 : c
  20 :       MLREEL=IPTG
  21 :       SEGACT MLREEL
  22 : c
  23 : c     ordonnees connues de l'objet evolution
  24 : c
  25 :       MLREE1=IPGG
  26 :       SEGACT MLREE1
  27 : c
  28 : c     abcisses dont on cherche les ordonnees dans l'objet evolution
  29 : c
  30 :       MLREE2=IPT
  31 :       SEGACT MLREE2
  32 : c
  33 : c     ordonnees recherchees
  34 : c
  35 :       LON1=MLREEL.PROG(/1)
  36 :       LON2=MLREE2.PROG(/1)
  37 :       JG=LON2
  38 :       SEGINI MLREE3
  39 :       IPG=MLREE3
  40 :       N1=1
  41 :       N2=LON1
  42 : c
  43 : c     interpolation lineaire
  44 : c
  45 :       DO 13 I=1,LON2
  46 :       TO=MLREE2.PROG(I)
  47 :   11  CONTINUE
  48 :       N2N1=N2-N1
  49 :       IF (N2N1.EQ.1) GOTO 12
  50 :       NC=(N1+N2)/2
  51 :       PRT=PROG(NC)
  52 :       IF (TO.LT.PRT) THEN
  53 :            N2=NC
  54 :       ELSE
  55 :            N1=NC
  56 :       ENDIF
  57 :       GOTO 11
  58 :   12  CONTINUE
  59 :       PRT1=PROG(N1)
  60 :       PRT2=PROG(N2)
  61 :       ALPHA=(TO-PRT1)/(PRT2-PRT1)
  62 :       PRF1=MLREE1.PROG(N1)
  63 :       PRF2=MLREE1.PROG(N2)
  64 :       MLREE3.PROG(I)=ALPHA*(PRF2-PRF1)+PRF1
  65 :       IF (TO .GT. PRT2)  THEN
  66 : c        au dela de la définition de (iptg,ipgg) on extrapole à 0.
  67 :         MLREE3.PROG(I)=0.D0
  68 :       ENDIF
  69 :       N2=LON1
  70 :   13  CONTINUE
  71 : c
  72 :       SEGDES MLREEL
  73 :       SEGDES MLREE1
  74 :       SEGDES MLREE2
  75 :       SEGDES MLREE3
  76 :       RETURN
  77 :       END
  78 :  
  79 :