Télécharger fuite2.eso

Retour à la liste

Numérotation des lignes :

  1. C FUITE2 SOURCE CHAT 05/01/13 00:11:33 5004
  2. SUBROUTINE FUITE2(MELEME,N1,N2)
  3. C
  4. C FONCTION: SECONDE PARTIE DE L'OPÉRATEUR FUITE
  5. C scinde le contour meleme avec l'elemen t de fuite dont les
  6. C extrémités sont N1 et N2.
  7. C
  8. C ENTREES:
  9. C MELEME contour fermé orienté forme uniquement de seg2
  10. C N1 # du point extrémité de l'élément de fuite
  11. C N2 # du point extrémité de l'élément de fuite
  12. C
  13. C SORTIES:
  14. C avec ECROBJ
  15. C
  16. C
  17. C A de Gayffier
  18. C
  19. C FORTRAN + ESOPE
  20. C
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23. -INC SMELEME
  24. -INC CCOPTIO
  25. -INC SMCOORD
  26. C
  27. C ce segment contient les couples de points de MAIL5 et MAIL6
  28. C
  29. SEGMENT MAILRES
  30. INTEGER NMAIL5(NBEL,2),NMAIL6(NBEL,2)
  31. ENDSEGMENT
  32. C
  33. C creation de MAIL5 qui contient le segment N1->N2
  34. C
  35. NBEL = NUM(/2)
  36. SEGINI MAILRES
  37. C
  38. NMAIL5(1,1)=N1
  39. NMAIL5(1,2)=N2
  40. C
  41. NBEL5 = 1
  42. 100 IF (NMAIL5(NBEL5,2) .NE. NMAIL5(1,1)) THEN
  43. DO 110 I=1,NUM(/2)
  44. IF (NMAIL5(NBEL5,2) .EQ. NUM(1,I)) THEN
  45. NBEL5 = NBEL5 + 1
  46. NMAIL5(NBEL5,1)=NUM(1,I)
  47. NMAIL5(NBEL5,2)=NUM(2,I)
  48. GOTO 100
  49. ENDIF
  50. 110 CONTINUE
  51. C
  52. C le contour n'est pas fermé
  53. C
  54. R = ABS(XCOOR((NMAIL5(NBEL5,2)-1)*(IDIM+1)+1))
  55. DENS = MAX(XCOOR((NMAIL5(NBEL5,2)-1)*(IDIM+1)),1.D-10)
  56. C
  57. C est on en axisymétrique
  58. C
  59. IF (IFOUR .EQ. 0 .AND. R .LT. DENS) GOTO 1000
  60. C
  61. C Le contour n'est pas fermé
  62. C
  63. CALL ERREUR(28)
  64. SEGSUP MAILRES
  65. RETURN
  66. ENDIF
  67. C
  68. C
  69. C creation de MAIL6 qui contient le segment N2->N1
  70. C
  71. C
  72. 200 CONTINUE
  73. NMAIL6(1,1)=N2
  74. NMAIL6(1,2)=N1
  75. C
  76. NBEL6 = 1
  77. 210 IF (NMAIL6(NBEL6,2) .NE. NMAIL6(1,1)) THEN
  78. DO 220 I=1,NUM(/2)
  79. IF (NMAIL6(NBEL6,2) .EQ. NUM(1,I)) THEN
  80. NBEL6 = NBEL6 + 1
  81. NMAIL6(NBEL6,1)=NUM(1,I)
  82. NMAIL6(NBEL6,2)=NUM(2,I)
  83. GOTO 210
  84. ENDIF
  85. 220 CONTINUE
  86. C
  87. C le contour n'est pas fermé
  88. C
  89. R = ABS(XCOOR((NMAIL6(NBEL6,2)-1)*(IDIM+1)+1))
  90. DENS = MAX(XCOOR((NMAIL6(NBEL6,2)-1)*(IDIM+1)),1.D-10)
  91. C
  92. C est on en axisymétrique
  93. C
  94. IF (IFOUR .EQ. 0 .AND. R .LT. DENS) GOTO 2000
  95. C
  96. C Le contour n'est pas fermé
  97. C
  98. CALL ERREUR(28)
  99. SEGSUP MAILRES
  100. RETURN
  101. ENDIF
  102. C
  103. C
  104. C ecriture des maillage
  105. C
  106. C
  107. 300 CONTINUE
  108. C
  109. NBREF = 0
  110. NBSOUS = 0
  111. NBNN = 2
  112. NBELEM = 1
  113. SEGINI IPT4
  114. IPT4.ITYPEL = 2
  115. IPT4.NUM(1,1) = N1
  116. IPT4.NUM(2,1) = N2
  117. C
  118. NBELEM = NBEL5
  119. SEGINI IPT5
  120. IPT5.ITYPEL = 2
  121. DO 310 I=1,NBEL5
  122. IPT5.NUM(1,I) = NMAIL5(I,1)
  123. IPT5.NUM(2,I) = NMAIL5(I,2)
  124. 310 CONTINUE
  125. C
  126. NBELEM = NBEL6
  127. SEGINI IPT6
  128. IPT6.ITYPEL = 2
  129. DO 320 I=1,NBEL6
  130. IPT6.NUM(1,I) = NMAIL6(I,1)
  131. IPT6.NUM(2,I) = NMAIL6(I,2)
  132. 320 CONTINUE
  133. C
  134. CALL ECROBJ('MAILLAGE',IPT6)
  135. CALL ECROBJ('MAILLAGE',IPT5)
  136. CALL ECROBJ('MAILLAGE',IPT4)
  137. C
  138. SEGDES IPT4,IPT5,IPT6
  139. SEGSUP MAILRES
  140. RETURN
  141. C
  142. C==============================================================
  143. C AXISYMMETRIQUE
  144. C mail5
  145. C
  146. 1000 CONTINUE
  147. C
  148. C le point extrème est sur l'axe, et on en axisymetrique
  149. C on parcours le contour dans l'autre sens
  150. NBELI = 1
  151. 1010 CONTINUE
  152. DO 1020 I=1,NUM(/2)
  153. IF (NMAIL5(NBELI,1) .EQ. NUM(2,I)) THEN
  154. NBEL5 = NBEL5 + 1
  155. NBELI = NBEL5
  156. NMAIL5(NBEL5,1)=NUM(1,I)
  157. NMAIL5(NBEL5,2)=NUM(2,I)
  158. GOTO 1010
  159. ENDIF
  160. 1020 CONTINUE
  161. C
  162. C
  163. C
  164. R = ABS(XCOOR((NMAIL5(NBEL5,1)-1)*(IDIM+1)+1))
  165. DENS = MAX(XCOOR((NMAIL5(NBEL5,1)-1)*(IDIM+1)),1.D-10)
  166. IF (R .GT. DENS) THEN
  167. CALL ERREUR(28)
  168. SEGSUP MAILRES
  169. RETURN
  170. ENDIF
  171. GOTO 200
  172. C
  173. C mail6 en axisymétrique
  174. C
  175. 2000 CONTINUE
  176. C
  177. C le point extrème est sur l'axe, et on en axisymetrique
  178. C on parcours le contour dans l'autre sens
  179. NBELI = 1
  180. 2010 CONTINUE
  181. DO 2020 I=1,NUM(/2)
  182. IF (NMAIL6(NBELI,1) .EQ. NUM(2,I)) THEN
  183. NBEL6 = NBEL6 + 1
  184. NBELI = NBEL6
  185. NMAIL6(NBEL6,1)=NUM(1,I)
  186. NMAIL6(NBEL6,2)=NUM(2,I)
  187. GOTO 2010
  188. ENDIF
  189. 2020 CONTINUE
  190. C
  191. C
  192. C
  193. R = ABS(XCOOR((NMAIL6(NBEL6,1)-1)*(IDIM+1)+1))
  194. DENS = MAX(XCOOR((NMAIL6(NBEL6,1)-1)*(IDIM+1)),1.D-10)
  195. IF (R .GT. DENS) THEN
  196. CALL ERREUR(28)
  197. SEGSUP MAILRES
  198. RETURN
  199. ENDIF
  200. GOTO 300
  201. C
  202. END
  203.  
  204.  
  205.  
  206.  

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