Télécharger inte33.eso

Retour à la liste

Numérotation des lignes :

  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.  
  80.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales