Télécharger la plaquette Cast3M


fr en

Télécharger inter4.eso

Retour à la liste

Numérotation des lignes : 

inter4

  1. C INTER4    SOURCE    PASCAL    21/02/24    21:15:08     10898          
  2. C 
  3.       SUBROUTINE INTER4(TEMPS,KTE,KFT,IHORS,IRET)
  4. C
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C   INTERPOLATION LINEAIRE ; recherche par parcours des abscisses
  8. C
  9. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10. C
  11. C  TEMPS  : valeur où interpoler la fonction
  12. C  KTE    : abscisses de la fonction à interpoler
  13. C  KFT    : ordonnées de la fonction à interpoler
  14. C  IHORS  : option comportement hors intervalle definition donnees
  15. C  - IHORS = 0 : erreur
  16. C  - IHORS = 1 : renvoie valeurs aux bornes
  17. C  IRET   : code retour = pointeur vers listreel si succès, 0 sinon
  18. C
  19. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  20.       IMPLICIT INTEGER(I-N)
  21.       IMPLICIT REAL*8(A-H,O-Z)
  22. -INC SMLREEL
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC CCREEL
  27. *
  28.       IRET=0
  29.       JG=0
  30.       SEGINI,MLREEL
  31.  
  32.       MLREE1=KTE
  33.       MLREE2=KFT
  34.       LON1=MLREE1.PROG(/1)
  35.  
  36. C---- CAS IHORS = 0 : erreur si hors intervalle de def.
  37.  
  38.       IF (IHORS.EQ.0) THEN
  39.         TINF = MLREE1.PROG(1)
  40.         TSUP = MLREE1.PROG(LON1)
  41.         IF (TEMPS.LT.TINF.OR.TEMPS.GT.TSUP) THEN
  42.            CALL ERREUR(210)
  43.            RETURN
  44.         ENDIF
  45.       ENDIF
  46.  
  47. C---- CAS GENERAL :
  48.  
  49.       I=0
  50. c     -------------- BOUCLE SUR LES SEGMENTS
  51.  1    CONTINUE
  52.       I=I+1
  53.       IF(I.GE.LON1) GOTO 70
  54.  
  55.       T1=MLREE1.PROG(I)
  56.       T2=MLREE1.PROG(I+1)
  57.  
  58. C     write(6,*) 'T1,T2,TEMPS', T1,T2,TEMPS
  59.  
  60. C Cas fonction multivaluee (DT=0) :
  61.       DT=T2-T1
  62.       IF (ABS(DT).LE.(XZPREC*MAX(ABS(T1),ABS(T2))+XPETIT)) THEN
  63.  
  64.         IF (TEMPS.NE.T1.AND.TEMPS.NE.T2) GOTO 1
  65.  
  66.         FT0=MLREE2.PROG(I)
  67.  
  68. C Autres cas :
  69.       ELSE
  70.  
  71. C     Test si TEMPS dans intervalle :
  72.         IF     (T1.LE.TEMPS.AND.TEMPS.LT.T2) THEN       
  73.         ELSEIF (T1.GE.TEMPS.AND.TEMPS.GT.T2) THEN 
  74.         ELSE
  75.           GOTO 1
  76.         ENDIF
  77.  
  78. c     INTERPOLATION
  79.         XP2=(TEMPS-T1)/DT
  80.         XP1=(T2-TEMPS)/DT
  81.         FT1=MLREE2.PROG(I)
  82.         FT2=MLREE2.PROG(I+1)
  83.         FT0=(XP1*FT1)+(XP2*FT2)
  84.       ENDIF
  85.  
  86.       PROG(**)=FT0
  87.  
  88.       GOTO 1
  89. c     -------------- FIN DE BOUCLE SUR LES SEGMENTS
  90.  
  91.  70   CONTINUE
  92. C     SEGDES,MLREEL
  93.       IRET=MLREEL
  94.  
  95.       RETURN
  96.       END
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  

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