Télécharger la plaquette Cast3M


fr en

Télécharger valpar.eso

Retour à la liste

Numérotation des lignes : 

valpar

  1. C VALPAR    SOURCE    CHAT      05/01/13    04:00:47     5004
  2.       SUBROUTINE VALPAR(COURB,NPTEUR,NCOURB,NC,X,Y,YPRIM,T,
  3.      & TINF,TSUP,COURB1,NC1)
  4. C
  5. C---------------------------------------------------------------------
  6. C Objet: calcul de la valeur d'une fonction F et de sa derivee
  7. C        en un point X donne et pour une valeur de T precisee.
  8. C        Cette fonction est discretisee en NPTS points et connue
  9. C        pour differentes valeurs du parametre T.
  10. C        Elle est tabulee de la facon suivante suivante:
  11. C        COURB(T1,X1,F(X1),X2,F(X2),.....,T2,Y1,F(Y1),Y2,F(Y2),...)
  12. C---------------------------------------------------------------------
  13. C
  14. C---------------------------------------------------------------------
  15. C Entree: NPTEUR(NC) tableau contenant les nombres de points de
  16. C          discretisation pour chaque courbe a T fixee.
  17. C          Ex: si NPTEUR(1)=20 alors pour la valeur T=T1 la fonction
  18. C         Y=F(X,T1) est discretisee sur 20 points.
  19. C         NC nombre de courbes connues pour T1,T2,....
  20. C         NCOURB dimension du tableau COURB
  21. C         COURB(NCOURB) tableau decrit ci-dessus
  22. C         COURB1(NC1) tableau de travail
  23. C         X,T point et parametre d'interpolation
  24. C---------------------------------------------------------------------
  25. C
  26. C---------------------------------------------------------------------
  27. C Sortie: Y=F(X,T) valeur interpolee de la fonction F au point (X,T)
  28. C---------------------------------------------------------------------
  29. C
  30.       IMPLICIT INTEGER(I-N)
  31.       IMPLICIT REAL*8(A-H,O-Z)
  32.       DIMENSION NPTEUR(*),COURB(*),COURB1(*)
  33. C
  34. C--------------------------------------
  35. C Courbe independante de la temperature
  36. C--------------------------------------
  37.       IF (NC.EQ.1) THEN
  38.                         TINF=T
  39.                         TSUP=T
  40.                         LTINF=0
  41.                         LTSUP=0
  42.                         NPTINF=NPTEUR(1)
  43.                         NPTSUP=NPTEUR(1)
  44.                         GOTO 100
  45.       ENDIF
  46. C
  47. C------------------------------------------------------
  48. C Recherche des temperatures extremes connues TMIN,TMAX
  49. C------------------------------------------------------
  50.       TMIN=COURB(1)
  51.       KT=0
  52.       DO 5 I=1,NC-1
  53. 5     KT=KT+NPTEUR(I)
  54.       KT=2*KT
  55.       KT=KT+NC
  56.       TMAX=COURB(KT)
  57. C
  58. C---------------------------------------------------------------------
  59. C T plus petit que la plus petite des temperatures ou plus grande que
  60. C               la plus grande des temperatures
  61. C---------------------------------------------------------------------
  62.       IF (T.LT.TMIN) THEN
  63.                          TINF=T
  64.                          TSUP=T
  65.                          LTINF=1
  66.                          LTSUP=1
  67.                          NPTINF=NPTEUR(1)
  68.                          NPTSUP=NPTEUR(1)
  69.                          GOTO 100
  70.       ENDIF
  71.       IF (T.GE.TMAX) THEN
  72.                          TINF=T
  73.                          TSUP=T
  74.                          LTINF=KT
  75.                          LTSUP=KT
  76.                          NPTINF=NPTEUR(NC)
  77.                          NPTSUP=NPTEUR(NC)
  78.                          GOTO 100
  79.       ENDIF
  80. C
  81. C---------------------------------------------------------------------
  82. C Recherche de l'intervalle de temperature [TINF,TSUP] comprenant T
  83. C---------------------------------------------------------------------
  84.       I=1
  85.       KC=1
  86. 30    CONTINUE
  87.       NPTINF=NPTEUR(KC)
  88.       IF ( T.LT.COURB(I+2*NPTINF+1) ) THEN
  89.           LTINF=I
  90.           LTSUP=I+2*NPTINF+1
  91.           TINF=COURB(LTINF)
  92.           TSUP=COURB(LTSUP)
  93.           NPTSUP=NPTEUR(KC+1)
  94.           GOTO 100
  95.         ELSE
  96.           I=I+2*NPTINF+1
  97.           KC=KC+1
  98.           GOTO 30
  99.       ENDIF
  100. C
  101. 100   CONTINUE
  102. C
  103. C--------------------------------------------------------------------
  104. C Sauvegarde des courbes de F(X,T) pour TINF et TSUP
  105. C--------------------------------------------------------------------
  106.       N1=2*NPTINF
  107.       DO 50 J=1,N1
  108. 50      COURB1(J)=COURB(J+LTINF)
  109. C--------------------
  110. C Calcul de F(X,TINF)
  111. C
  112.       CALL DERTRA(N1,COURB1,X,Y1,YPRIM1,XINF,XSUP)
  113. C
  114.       N2=2*NPTSUP
  115.       DO 60 J=1,N2
  116. 60      COURB1(J)=COURB(J+LTSUP)
  117. C--------------------
  118. C Calcul de F(X,TSUP)
  119. C
  120.       CALL DERTRA(N2,COURB1,X,Y2,YPRIM2,XINF,XSUP)
  121. C
  122. C-------------------------------------------------------------------
  123. C  T appartenant a [TINF,TSUP] i.e T=TETA*TINF+(1-TETA)*TSUP
  124. C  F(X,T)=TETA*F(X,TINF)+(1-TETA)*F(X,TSUP)
  125. C-------------------------------------------------------------------
  126.       IF (TINF.EQ.TSUP) THEN
  127.           TETA=0.
  128.         ELSE
  129.           TETA=(T-TSUP)/(TINF-TSUP)
  130.       ENDIF
  131.       Y=TETA*Y1+(1-TETA)*Y2
  132.       YPRIM=TETA*YPRIM1+(1-TETA)*YPRIM2
  133. C
  134.       RETURN
  135.       END
  136.  
  137.  
  138.  

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