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.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMCOORD
  28. C
  29. C ce segment contient les couples de points de MAIL5 et MAIL6
  30. C
  31. SEGMENT MAILRES
  32. INTEGER NMAIL5(NBEL,2),NMAIL6(NBEL,2)
  33. ENDSEGMENT
  34. C
  35. C creation de MAIL5 qui contient le segment N1->N2
  36. C
  37. NBEL = NUM(/2)
  38. SEGINI MAILRES
  39. C
  40. NMAIL5(1,1)=N1
  41. NMAIL5(1,2)=N2
  42. C
  43. NBEL5 = 1
  44. 100 IF (NMAIL5(NBEL5,2) .NE. NMAIL5(1,1)) THEN
  45. DO 110 I=1,NUM(/2)
  46. IF (NMAIL5(NBEL5,2) .EQ. NUM(1,I)) THEN
  47. NBEL5 = NBEL5 + 1
  48. NMAIL5(NBEL5,1)=NUM(1,I)
  49. NMAIL5(NBEL5,2)=NUM(2,I)
  50. GOTO 100
  51. ENDIF
  52. 110 CONTINUE
  53. C
  54. C le contour n'est pas fermé
  55. C
  56. R = ABS(XCOOR((NMAIL5(NBEL5,2)-1)*(IDIM+1)+1))
  57. DENS = MAX(XCOOR((NMAIL5(NBEL5,2)-1)*(IDIM+1)),1.D-10)
  58. C
  59. C est on en axisymétrique
  60. C
  61. IF (IFOUR .EQ. 0 .AND. R .LT. DENS) GOTO 1000
  62. C
  63. C Le contour n'est pas fermé
  64. C
  65. CALL ERREUR(28)
  66. SEGSUP MAILRES
  67. RETURN
  68. ENDIF
  69. C
  70. C
  71. C creation de MAIL6 qui contient le segment N2->N1
  72. C
  73. C
  74. 200 CONTINUE
  75. NMAIL6(1,1)=N2
  76. NMAIL6(1,2)=N1
  77. C
  78. NBEL6 = 1
  79. 210 IF (NMAIL6(NBEL6,2) .NE. NMAIL6(1,1)) THEN
  80. DO 220 I=1,NUM(/2)
  81. IF (NMAIL6(NBEL6,2) .EQ. NUM(1,I)) THEN
  82. NBEL6 = NBEL6 + 1
  83. NMAIL6(NBEL6,1)=NUM(1,I)
  84. NMAIL6(NBEL6,2)=NUM(2,I)
  85. GOTO 210
  86. ENDIF
  87. 220 CONTINUE
  88. C
  89. C le contour n'est pas fermé
  90. C
  91. R = ABS(XCOOR((NMAIL6(NBEL6,2)-1)*(IDIM+1)+1))
  92. DENS = MAX(XCOOR((NMAIL6(NBEL6,2)-1)*(IDIM+1)),1.D-10)
  93. C
  94. C est on en axisymétrique
  95. C
  96. IF (IFOUR .EQ. 0 .AND. R .LT. DENS) GOTO 2000
  97. C
  98. C Le contour n'est pas fermé
  99. C
  100. CALL ERREUR(28)
  101. SEGSUP MAILRES
  102. RETURN
  103. ENDIF
  104. C
  105. C
  106. C ecriture des maillage
  107. C
  108. C
  109. 300 CONTINUE
  110. C
  111. NBREF = 0
  112. NBSOUS = 0
  113. NBNN = 2
  114. NBELEM = 1
  115. SEGINI IPT4
  116. IPT4.ITYPEL = 2
  117. IPT4.NUM(1,1) = N1
  118. IPT4.NUM(2,1) = N2
  119. C
  120. NBELEM = NBEL5
  121. SEGINI IPT5
  122. IPT5.ITYPEL = 2
  123. DO 310 I=1,NBEL5
  124. IPT5.NUM(1,I) = NMAIL5(I,1)
  125. IPT5.NUM(2,I) = NMAIL5(I,2)
  126. 310 CONTINUE
  127. C
  128. NBELEM = NBEL6
  129. SEGINI IPT6
  130. IPT6.ITYPEL = 2
  131. DO 320 I=1,NBEL6
  132. IPT6.NUM(1,I) = NMAIL6(I,1)
  133. IPT6.NUM(2,I) = NMAIL6(I,2)
  134. 320 CONTINUE
  135. C
  136. CALL ECROBJ('MAILLAGE',IPT6)
  137. CALL ECROBJ('MAILLAGE',IPT5)
  138. CALL ECROBJ('MAILLAGE',IPT4)
  139. C
  140. SEGDES IPT4,IPT5,IPT6
  141. SEGSUP MAILRES
  142. RETURN
  143. C
  144. C==============================================================
  145. C AXISYMMETRIQUE
  146. C mail5
  147. C
  148. 1000 CONTINUE
  149. C
  150. C le point extrème est sur l'axe, et on en axisymetrique
  151. C on parcours le contour dans l'autre sens
  152. NBELI = 1
  153. 1010 CONTINUE
  154. DO 1020 I=1,NUM(/2)
  155. IF (NMAIL5(NBELI,1) .EQ. NUM(2,I)) THEN
  156. NBEL5 = NBEL5 + 1
  157. NBELI = NBEL5
  158. NMAIL5(NBEL5,1)=NUM(1,I)
  159. NMAIL5(NBEL5,2)=NUM(2,I)
  160. GOTO 1010
  161. ENDIF
  162. 1020 CONTINUE
  163. C
  164. C
  165. C
  166. R = ABS(XCOOR((NMAIL5(NBEL5,1)-1)*(IDIM+1)+1))
  167. DENS = MAX(XCOOR((NMAIL5(NBEL5,1)-1)*(IDIM+1)),1.D-10)
  168. IF (R .GT. DENS) THEN
  169. CALL ERREUR(28)
  170. SEGSUP MAILRES
  171. RETURN
  172. ENDIF
  173. GOTO 200
  174. C
  175. C mail6 en axisymétrique
  176. C
  177. 2000 CONTINUE
  178. C
  179. C le point extrème est sur l'axe, et on en axisymetrique
  180. C on parcours le contour dans l'autre sens
  181. NBELI = 1
  182. 2010 CONTINUE
  183. DO 2020 I=1,NUM(/2)
  184. IF (NMAIL6(NBELI,1) .EQ. NUM(2,I)) THEN
  185. NBEL6 = NBEL6 + 1
  186. NBELI = NBEL6
  187. NMAIL6(NBEL6,1)=NUM(1,I)
  188. NMAIL6(NBEL6,2)=NUM(2,I)
  189. GOTO 2010
  190. ENDIF
  191. 2020 CONTINUE
  192. C
  193. C
  194. C
  195. R = ABS(XCOOR((NMAIL6(NBEL6,1)-1)*(IDIM+1)+1))
  196. DENS = MAX(XCOOR((NMAIL6(NBEL6,1)-1)*(IDIM+1)),1.D-10)
  197. IF (R .GT. DENS) THEN
  198. CALL ERREUR(28)
  199. SEGSUP MAILRES
  200. RETURN
  201. ENDIF
  202. GOTO 300
  203. C
  204. END
  205.  
  206.  
  207.  
  208.  

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