Télécharger fuite1.eso

Retour à la liste

Numérotation des lignes :

  1. C FUITE1 SOURCE CHAT 05/01/13 00:11:29 5004
  2. SUBROUTINE FUITE1
  3. C
  4. C FONCTION: DRIVER DE L'OPÉRATEUR FUITE
  5. C
  6. C recupere l'intersection de MAIL1 et MAIL2 et de MAIL1 et MAIL3
  7. C determine le segment de fuite
  8. C appelle fuite2.eso
  9. C
  10. C
  11. C ENTREES:
  12. C
  13. C MAIL1: (objet de type MAILLAGE) contour orienté fermé formé d'éléments
  14. C de type SEG2 ou SEG3.
  15. C
  16. C MAIL2: (objet de type MAILLAGE) dont un des points sera le support d'une
  17. C des extremité de l'élément de fuite.
  18. C
  19. C MAIL3: (objet de type MAILLAGE) dont un des points sera le support de
  20. C l'autre extremité de l'élément de fuite.
  21. C
  22. C SORTIES:
  23. C
  24. C MAIL4: (objet de type MAILLAGE) contenant un élément de type SEG2 et qui
  25. C est l'élément de fuite. (MAIL4 est aussi contenu dans MAIL5 et son
  26. C inverse dans MAIL6).
  27. C
  28. C MAIL5: (objet de type MAILLAGE) contenant un des deux contours fermés
  29. C orientés issu de MAIL1.
  30. C
  31. C MAIL6: (objet de type MAILLAGE) contenant le second contour fermé
  32. C orienté issu de MAIL1.
  33. C
  34. C
  35. C
  36. C A de Gayffier
  37. C
  38. C FORTRAN + ESOPE
  39. C
  40. IMPLICIT INTEGER(I-N)
  41. IMPLICIT REAL*8(A-H,O-Z)
  42. -INC SMELEME
  43. -INC CCOPTIO
  44. -INC SMCOORD
  45. C
  46. SEGMENT MPACTIF
  47. C ce segment contient les noeuds actifs de MAIL2 et MAIL3
  48. C et leur adresse dans MELEME
  49. INTEGER NMAIL2(NBN2),NMAIL3(NBN3)
  50. ENDSEGMENT
  51. C
  52. C l'opérateur ne marche qu'en dimension 2
  53. C
  54. IF (IDIM .NE. 2 ) THEN
  55. INTERR(1) = IDIM
  56. CALL ERREUR(709)
  57. RETURN
  58. ENDIF
  59. C
  60. C on recupere MAIL1 meleme , MAIL2 ipt1 et MAIL3 ipt2
  61. C
  62. CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  63. IF (IERR .NE. 0) RETURN
  64. CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
  65. IF (IERR .NE. 0) RETURN
  66. CALL LIROBJ('MAILLAGE',IPT3,1,IRETOU)
  67. IF (IERR .NE. 0) RETURN
  68. C
  69. C
  70. C
  71. SEGACT MELEME
  72. IF (LISOUS(/1) .NE. 0 .OR. ITYPEL .NE. 2) THEN
  73. CALL ERREUR(164)
  74. RETURN
  75. ENDIF
  76. C
  77. C intersection de MAIL1 et MAIL2
  78. C
  79. C changement de MAIL2 et MAIL3 en maillage formé de points
  80. CALL CHANGE(IPT2,1)
  81. CALL CHANGE(IPT3,1)
  82. NBN2 = IPT2.NUM(/2)
  83. NBN3 = IPT3.NUM(/2)
  84. SEGINI MPACTIF
  85. C
  86. C ipt1 et ipt2 sont actifs et formé d'une seule sous zone
  87. C
  88. NNBN2 = 0
  89. DO 140 I=1,NBN2
  90. DO 120 K=1,NUM(/2)
  91. IF (IPT2.NUM(1,I) .EQ. NUM(1,K)) THEN
  92. NNBN2 = NNBN2 + 1
  93. NMAIL2(NNBN2) = IPT2.NUM(1,I)
  94. GOTO 140
  95. ENDIF
  96. 120 CONTINUE
  97. 140 CONTINUE
  98. NBN2 = NNBN2
  99. C
  100. C
  101. C
  102. NNBN3 = 0
  103. DO 180 I=1,NBN3
  104. DO 160 K=1,NUM(/2)
  105. IF (IPT3.NUM(1,I) .EQ. NUM(1,K)) THEN
  106. NNBN3 = NNBN3 + 1
  107. NMAIL3(NNBN3) = IPT3.NUM(1,I)
  108. GOTO 180
  109. ENDIF
  110. 160 CONTINUE
  111. 180 CONTINUE
  112. NBN3 = NNBN3
  113. C
  114. C erreur si nbn2 = 0 ou nbn3 = 0
  115. C
  116. IF ( (NBN3*NBN2) .EQ. 0) THEN
  117. GOTO 1000
  118. ENDIF
  119. C
  120. SEGADJ MPACTIF
  121. C
  122. C RECHERCHE DU MINIMUM
  123. C
  124. N1 = 0
  125. N2 = 0
  126. DMINI = 1.D50
  127. DO 200 I=1,NBN2
  128. DO 190 J=1,NBN3
  129. X2=XCOOR((NMAIL2(I)-1)*(IDIM+1)+1)
  130. Y2=XCOOR((NMAIL2(I)-1)*(IDIM+1)+2)
  131. X3=XCOOR((NMAIL3(J)-1)*(IDIM+1)+1)
  132. Y3=XCOOR((NMAIL3(J)-1)*(IDIM+1)+2)
  133. DIST = (X2-X3)*(X2-X3) + (Y2-Y3)*(Y2-Y3)
  134. IF (DIST .LT. DMINI) THEN
  135. DMINI = DIST
  136. N1 = NMAIL2(I)
  137. N2 = NMAIL3(J)
  138. ENDIF
  139. 190 CONTINUE
  140. 200 CONTINUE
  141. C
  142. C erreur mail2 et mail3 on un point en commun inclus dans MAIL1
  143. C
  144. IF (N1 .EQ. N2 ) THEN
  145. GOTO 1000
  146. ENDIF
  147.  
  148. C
  149. C
  150. C
  151. SEGDES IPT2,IPT3
  152. C
  153. CALL FUITE2(MELEME,N1,N2)
  154. C
  155. C
  156. C
  157. SEGDES MELEME
  158. SEGSUP MPACTIF
  159. RETURN
  160. C
  161. C gestion des erreurs
  162. C
  163. 1000 CONTINUE
  164. NBELEM = 0
  165. NBREF = 0
  166. NBNN = 0
  167. NBSOUS = 0
  168. SEGINI IPT4,IPT5
  169. IPT4.ITYPEL=2
  170. IPT5.ITYPEL=2
  171. C
  172. SEGDES MELEME,IPT4,IPT5
  173. SEGSUP MPACTIF
  174. C
  175. CALL ECROBJ('MAILLAGE',IPT4)
  176. CALL ECROBJ('MAILLAGE',IPT5)
  177. CALL ECROBJ('MAILLAGE',MELEME)
  178. C
  179. RETURN
  180. END
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  

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