Télécharger fus.eso

Retour à la liste

Numérotation des lignes :

  1. C FUS SOURCE CHAT 05/01/13 00:12:27 5004
  2.  
  3. SUBROUTINE FUS(TRAC1,TRAC2,FUS1,FUS2,N1,N2,NFUS)
  4. C
  5. C-------------------------------------------------------------------------
  6. C Objet:fusion de deux tableaux de reels de la forme (X1,F(X1),X2,F(X2),...)
  7. C et (Y1,G(Y1),Y2,G(Y2),....);ils contiennent en fait les points de
  8. C 2 courbes de traction definies aux 2 temperatures TINF et TSUP
  9. C encadrant la temperature T,pour laquelle on veut determiner la
  10. C courbe de traction.
  11. C---------------------------------------------------------------------------
  12. C
  13. C---------------------------------------------------------------------------
  14. C Entrees:
  15. C -------
  16. C N1 = nbre de points de la courbe de traction a la temperature TINF.
  17. C TRAC1(N1) = tableau de dimension 2N1 de la forme (X1,F(X1),X2,F(X2),..)
  18. C contenant les points de la courbe de traction a la temperature
  19. C TINF.
  20. C N2 = nbre de points de la courbe de traction a la temperature TSUP.
  21. C TRAC2(N2) = tableau de dimension 2N2 de la forme (Y1,G(Y1),Y2,G(Y2),..)
  22. C contenant les points de la courbe de traction a la temperature
  23. C TSUP.
  24. C---------------------------------------------------------------------------
  25. C
  26. C---------------------------------------------------------------------------
  27. C Sorties:
  28. C -------
  29. C NFUS
  30. C FUS1 = tableau contenant les abscisses completes dans l'ordre croissant
  31. C (i.e. X1,X2,... et Y1,Y2,...) et pour chacune d'elles la valeur
  32. C de la fonction F.
  33. C FUS2 = tableau contenant les abscisses completes dans l'ordre croissant
  34. C (i.e. X1,X2,... et Y1,Y2,...) et pour chacune d'elles la valeur
  35. C de la fonction G.
  36. C---------------------------------------------------------------------------
  37. C
  38. IMPLICIT INTEGER(I-N)
  39. IMPLICIT REAL*8 (A-H,O-Z)
  40. DIMENSION TRAC1(*),TRAC2(*),FUS1(*),FUS2(*)
  41. C
  42. C----------------------------------------------------------------------
  43. C on commence par determiner la dimension des tableaux finaux FUS1 et FUS2
  44. C------------------------------------------------------------------------
  45. NFUS=N1+N2
  46. DO 1 I1=1,2*N1-1,2
  47. DO 2 I2=1,2*N2-1,2
  48. IF (TRAC1(I1).EQ.TRAC2(I2)) THEN
  49. NFUS=NFUS-1
  50. ENDIF
  51. 2 CONTINUE
  52. 1 CONTINUE
  53. C
  54. I1=1
  55. I2=1
  56. I=1
  57. 100 CONTINUE
  58. C-----------------------------------------------------------------
  59. C tant que l'on ne depasse pas la limite des tableaux ...
  60. C-----------------------------------------------------------------
  61. DO WHILE ((I1.LE.(2*N1-1)).AND.(I2.LE.(2*N2-1)))
  62. C
  63. C------------------------------------------------------------------------
  64. C si l'element du tableau1 ,sur lequel on pointe, est < a l'element du
  65. C tableau2 sur lequel on pointe,on remplit FUS1 avec le plus petit des
  66. C elements sur lesquels on pointe suivi de la valeur de la fonction F
  67. C en ce point;on procede de meme avec FUS2 en le remplissant avec le plus
  68. C petit element suivi de la valeur de la fonction G en ce point;
  69. C le sous-programme DERTRA est ainsi utilise pour calculer la valeur de la
  70. C fonction F ou G aux points ou elles ne sont pas connues
  71. C------------------------------------------------------------------------
  72. IF (TRAC1(I1).LT.TRAC2(I2)) THEN
  73. FUS1(I)=TRAC1(I1)
  74. FUS1(I+1)=TRAC1(I1+1)
  75. FUS2(I)=TRAC1(I1)
  76. IF (TRAC1(I1).LT.TRAC2(1)) THEN
  77. X=TRAC2(1)
  78. CALL DERTRA(2*N2,TRAC2,X,Y,YPRIM,XINF,XSUP)
  79. WRITE(*,*) 'T1<T2',I,X,Y,YPRIM
  80. FUS2(I+1)=YPRIM*(TRAC1(I1)-X)+TRAC2(I2+1)
  81. ELSE
  82. X=TRAC1(I1)
  83. CALL DERTRA(2*N2,TRAC2,X,Y,YPRIM,XINF,XSUP)
  84. FUS2(I+1)=Y
  85. ENDIF
  86. I=I+2
  87. I1=I1+2
  88.  
  89.  
  90. ELSEIF (TRAC1(I1).GT.TRAC2(I2)) THEN
  91.  
  92. FUS1(I)=TRAC2(I2)
  93. FUS2(I)=TRAC2(I2)
  94. FUS2(I+1)=TRAC2(I2+1)
  95. IF (TRAC2(I2).LT.TRAC1(1)) THEN
  96. X=TRAC1(1)
  97. CALL DERTRA(2*N1,TRAC1,X,Y,YPRIM,XINF,XSUP)
  98. WRITE(*,*) 'T1>T2',I,X,Y,YPRIM
  99. FUS1(I+1)=YPRIM*(TRAC2(I2)-X)+TRAC1(I1+1)
  100. ELSE
  101. X=TRAC2(I2)
  102. CALL DERTRA(2*N1,TRAC1,X,Y,YPRIM,XINF,XSUP)
  103. FUS1(I+1)=Y
  104. ENDIF
  105. I=I+2
  106. I2=I2+2
  107.  
  108. ELSEIF (TRAC1(I1).EQ.TRAC2(I2)) THEN
  109. FUS1(I)=TRAC1(I1)
  110. FUS1(I+1)=TRAC1(I1+1)
  111. FUS2(I)=TRAC2(I2)
  112. FUS2(I+1)=TRAC2(I2+1)
  113.  
  114.  
  115. I1=I1+2
  116. I2=I2+2
  117. I=I+2
  118.  
  119. ENDIF
  120. ENDDO
  121. C
  122. IF (I1.GT.(2*N1-1)) THEN
  123. DO 10 K=I2,2*N2,2
  124. II1=(I-1)
  125. FUS2(I)=TRAC2(K)
  126. FUS2(I+1)=TRAC2(K+1)
  127. FUS1(I)=TRAC2(K)
  128. X=FUS1(I-2)
  129. CALL DERTRA(II1,FUS1,X,Y,YPRIM,XINF,XSUP)
  130. FUS1(I+1)=YPRIM*(FUS2(I)-X)+FUS1(I-1)
  131. I=I+2
  132.  
  133. 10 CONTINUE
  134.  
  135. ELSEIF (I2.GT.(2*N2)) THEN
  136. DO 20 K=I1,2*N1,2
  137. II1=(I-1)
  138. FUS1(I)=TRAC1(K)
  139. FUS1(I+1)=TRAC1(K+1)
  140. FUS2(I)=TRAC1(K)
  141. X=FUS2(I-2)
  142. CALL DERTRA(II1,FUS2,X,Y,YPRIM,XINF,XSUP)
  143. FUS2(I+1)=YPRIM*(FUS1(I)-X)+FUS2(I-1)
  144. I=I+2
  145.  
  146. 20 CONTINUE
  147.  
  148.  
  149. ENDIF
  150. RETURN
  151. END
  152. ************************************************************************
  153.  
  154.  

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