Télécharger tractt.eso

Retour à la liste

Numérotation des lignes :

  1. C TRACTT SOURCE CHAT 05/01/13 03:44:25 5004
  2.  
  3. SUBROUTINE TRACTT(COURB,NPTEUR,TRAC,NCOURB,NC,NNFUS,T)
  4. C
  5. C
  6. C---------------------------------------------------------------------
  7. C Objet:
  8. C -----
  9. C Ce sous-programme determine la courbe de traction a la temp.T
  10. C a partir de celles aux temperatures TINF et TSUP qui encadrent
  11. C T.Il utilise le sous-programme FUSION qui effectue la fusion
  12. C des 2 courbes de traction definies aux temperatures TINF et
  13. C TSUP,TINF < T < TSUP.
  14. C---------------------------------------------------------------------
  15. C
  16. C---------------------------------------------------------------------
  17. C Entrees:
  18. C -------
  19. C NPTEUR(NC) = tableau contenant les nombres de points de discretisation
  20. C pour chaque courbe a T fixee.
  21. C Ex: si NPTEUR(1)=20 alors pour la valeur T=T1 la fonction
  22. C Y=F(X,T1) est discretisee sur 20 points.
  23. C NC = nombre de courbes connues pour T1,T2,....
  24. C NCOURB = dimension du tableau COURB
  25. C COURB(NCOURB) = tableau contenant les courbes de traction a differentes
  26. C temperatures T1,T2,T3,...
  27. C X,T = point et parametre d'interpolation.
  28. C---------------------------------------------------------------------
  29. C
  30. C---------------------------------------------------------------------
  31. C Sorties:
  32. C -------
  33. C NNFUS = dimension du tableau TRAC.
  34. C TRAC(NNFUS)= courbe de traction a la temperature T;c'est la courbe
  35. C (espp,sigma).
  36. C---------------------------------------------------------------------
  37. C
  38. IMPLICIT INTEGER(I-N)
  39. IMPLICIT REAL*8(A-H,O-Z)
  40. DIMENSION NPTEUR(*),COURB(*),COURB1(260),COURB2(260)
  41. DIMENSION FUS1(520),FUS2(520),TRAC(*)
  42.  
  43. EPS1 = 1.D-8
  44.  
  45. C
  46. C--------------------------------------
  47. C Courbe independante de la temperature
  48. C--------------------------------------
  49. IF (NC.EQ.1) THEN
  50. TINF=T
  51. TSUP=T
  52. LTINF=0
  53. LTSUP=0
  54. NPTINF=NPTEUR(1)
  55. NPTSUP=NPTEUR(1)
  56. GOTO 100
  57. ENDIF
  58. C
  59. C------------------------------------------------------
  60. C Recherche des temperatures extremes connues TMIN,TMAX
  61. C------------------------------------------------------
  62. TMIN=COURB(1)
  63. KT=0
  64. DO 5 I=1,NC-1
  65. 5 KT=KT+NPTEUR(I)
  66. KT=2*KT
  67. KT=KT+NC
  68. TMAX=COURB(KT)
  69. C
  70. C---------------------------------------------------------------------
  71. C T plus petit que la plus petite des temperatures ou plus grande que
  72. C la plus grande des temperatures
  73. C---------------------------------------------------------------------
  74. IF (T.LT.TMIN) THEN
  75. TINF=T
  76. TSUP=T
  77. LTINF=1
  78. LTSUP=1
  79. NPTINF=NPTEUR(1)
  80. NPTSUP=NPTEUR(1)
  81. GOTO 100
  82. ENDIF
  83. IF (T.GT.TMAX) THEN
  84. TINF=T
  85. TSUP=T
  86. LTINF=KT
  87. LTSUP=KT
  88. NPTINF=NPTEUR(NC)
  89. NPTSUP=NPTEUR(NC)
  90. GOTO 100
  91. ENDIF
  92. C
  93. C---------------------------------------------------------------------
  94. C Recherche de l'intervalle de temperature [TINF,TSUP] comprenant T
  95. C---------------------------------------------------------------------
  96. I=1
  97. KC=1
  98. 30 CONTINUE
  99. NPTINF=NPTEUR(KC)
  100. IF ( T.LT.COURB(I+2*NPTINF+1) ) THEN
  101. LTINF=I
  102. LTSUP=I+2*NPTINF+1
  103. TINF=COURB(LTINF)
  104. TSUP=COURB(LTSUP)
  105. NPTSUP=NPTEUR(KC+1)
  106. GOTO 100
  107. ELSE
  108. I=I+2*NPTINF+1
  109. KC=KC+1
  110. GOTO 30
  111. ENDIF
  112. C
  113. 100 CONTINUE
  114. C
  115. C--------------------------------------------------------------------
  116. C Sauvegarde des courbes de F(X,T) pour TINF et TSUP
  117. C--------------------------------------------------------------------
  118. N1=2*NPTINF
  119. DO 50 J=1,N1
  120. 50 COURB1(J)=COURB(J+LTINF)
  121. C
  122. N2=2*NPTSUP
  123. DO 60 J=1,N2
  124. 60 COURB2(J)=COURB(J+LTSUP)
  125. C
  126. C---------------------------------------------------------------------
  127. C calcul des courbes de F(X,TINF) et de F(X,TSUP) pour les abscisses
  128. C completes i.e. pour la reunion des abscisses moins leur intersection
  129. C----------------------------------------------------------------------
  130. CALL FUS(COURB1,COURB2,FUS1,FUS2,NPTINF,NPTSUP,NFUS)
  131. C
  132. C----------------------------------------------------------------------
  133. C Les courbes de F(X,TINF) et de F(X,TSUP) ayant maintenant les memes
  134. C abscisses,on pretend la chose suivante :
  135. C si l'on a la relation T=(1-teta)TINF+(teta)TSUP , alors on ecrit
  136. C F(X,T) = (1-TETA)F(X,TINF) + (TETA)F(X,TSUP)
  137. C----------------------------------------------------------------------
  138. IF (TINF.EQ.TSUP) THEN
  139. TETA=0.
  140. ELSE
  141. TETA=(T-TINF)/(TSUP-TINF)
  142. ENDIF
  143. DO 88 M=1,2*NFUS-1,2
  144. TRAC(M)=FUS1(M)
  145. TRAC(M+1)=(1-TETA)*FUS1(M+1)+TETA*FUS2(M+1)
  146. 88 CONTINUE
  147.  
  148. C
  149. C---------------------------------------------------------------------
  150. C determination de la courbe (epsp,sigma) à T à partir de la courbe
  151. C (eps,sigma) à T
  152. C---------------------------------------------------------------------
  153.  
  154. DE=TRAC(4)/TRAC(3)
  155. NNFUS=NFUS-1
  156. DO 27 I=1,2*NNFUS-1,2
  157. TRAC(I)=TRAC(I+2)-TRAC(I+3)/DE
  158. TRAC(I+1)=TRAC(I+3)
  159. 27 CONTINUE
  160.  
  161. C Suppression des doublons
  162.  
  163. I1 = 1
  164. 29 CONTINUE
  165. IF (I1.GE.NNFUS) GOTO 31
  166. XI = ABS(TRAC(I1) - TRAC(I1+2))
  167. EPS2 = (ABS ( MIN(TRAC(I1),TRAC(I1+2)) ))*EPS1
  168. IF ( (XI.LE.EPS2) .OR.
  169. * ( (TRAC(I1).LE.EPS1).AND.(TRAC(I1+2).LE.EPS1))) THEN
  170. DO 28 I=I1,2*NNFUS-1,2
  171. TRAC(I)=TRAC(I+2)
  172. TRAC(I+1)=TRAC(I+3)
  173. 28 CONTINUE
  174. NNFUS=NNFUS - 1
  175. ELSE
  176. I1 = I1 + 2
  177. ENDIF
  178. GOTO 29
  179. 31 CONTINUE
  180.  
  181. C Mise à zero du premier point si necessaire
  182.  
  183. TRAC(1)=0.D0
  184. C
  185. END
  186. C*********************************************************************
  187.  
  188.  
  189.  
  190.  

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