Télécharger valpar.eso

Retour à la liste

Numérotation des lignes :

  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