Télécharger fuite1.eso

Retour à la liste

Numérotation des lignes :

  1. C FUITE1 SOURCE CB215821 17/11/30 21:16:16 9639
  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.  
  44. -INC PPARAM
  45. -INC CCOPTIO
  46. -INC SMCOORD
  47. C
  48. SEGMENT MPACTIF
  49. C ce segment contient les noeuds actifs de MAIL2 et MAIL3
  50. C et leur adresse dans MELEME
  51. INTEGER NMAIL2(NBN2),NMAIL3(NBN3)
  52. ENDSEGMENT
  53. C
  54. C l'opérateur ne marche qu'en dimension 2
  55. C
  56. IF (IDIM .NE. 2 ) THEN
  57. INTERR(1) = IDIM
  58. CALL ERREUR(709)
  59. RETURN
  60. ENDIF
  61. C
  62. C on recupere MAIL1 meleme , MAIL2 ipt1 et MAIL3 ipt2
  63. C
  64. CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
  65. IF (IERR .NE. 0) RETURN
  66. CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
  67. IF (IERR .NE. 0) RETURN
  68. CALL LIROBJ('MAILLAGE',IPT3,1,IRETOU)
  69. IF (IERR .NE. 0) RETURN
  70. C
  71. C
  72. C
  73. SEGACT MELEME
  74. IF (LISOUS(/1) .NE. 0 .OR. ITYPEL .NE. 2) THEN
  75. CALL ERREUR(164)
  76. RETURN
  77. ENDIF
  78. C
  79. C intersection de MAIL1 et MAIL2
  80. C
  81. C changement de MAIL2 et MAIL3 en maillage formé de points
  82. CALL CHANGE(IPT2,1)
  83. CALL CHANGE(IPT3,1)
  84. NBN2 = IPT2.NUM(/2)
  85. NBN3 = IPT3.NUM(/2)
  86. SEGINI MPACTIF
  87. C
  88. C ipt1 et ipt2 sont actifs et formé d'une seule sous zone
  89. C
  90. NNBN2 = 0
  91. DO 140 I=1,NBN2
  92. DO 120 K=1,NUM(/2)
  93. IF (IPT2.NUM(1,I) .EQ. NUM(1,K)) THEN
  94. NNBN2 = NNBN2 + 1
  95. NMAIL2(NNBN2) = IPT2.NUM(1,I)
  96. GOTO 140
  97. ENDIF
  98. 120 CONTINUE
  99. 140 CONTINUE
  100. NBN2 = NNBN2
  101. C
  102. C
  103. C
  104. NNBN3 = 0
  105. DO 180 I=1,NBN3
  106. DO 160 K=1,NUM(/2)
  107. IF (IPT3.NUM(1,I) .EQ. NUM(1,K)) THEN
  108. NNBN3 = NNBN3 + 1
  109. NMAIL3(NNBN3) = IPT3.NUM(1,I)
  110. GOTO 180
  111. ENDIF
  112. 160 CONTINUE
  113. 180 CONTINUE
  114. NBN3 = NNBN3
  115. C
  116. C erreur si nbn2 = 0 ou nbn3 = 0
  117. C
  118. IF ( (NBN3*NBN2) .EQ. 0) THEN
  119. GOTO 1000
  120. ENDIF
  121. C
  122. SEGADJ MPACTIF
  123. C
  124. C RECHERCHE DU MINIMUM
  125. C
  126. N1 = 0
  127. N2 = 0
  128. DMINI = 1.D50
  129. DO 200 I=1,NBN2
  130. DO 190 J=1,NBN3
  131. X2=XCOOR((NMAIL2(I)-1)*(IDIM+1)+1)
  132. Y2=XCOOR((NMAIL2(I)-1)*(IDIM+1)+2)
  133. X3=XCOOR((NMAIL3(J)-1)*(IDIM+1)+1)
  134. Y3=XCOOR((NMAIL3(J)-1)*(IDIM+1)+2)
  135. DIST = (X2-X3)*(X2-X3) + (Y2-Y3)*(Y2-Y3)
  136. IF (DIST .LT. DMINI) THEN
  137. DMINI = DIST
  138. N1 = NMAIL2(I)
  139. N2 = NMAIL3(J)
  140. ENDIF
  141. 190 CONTINUE
  142. 200 CONTINUE
  143. C
  144. C erreur mail2 et mail3 on un point en commun inclus dans MAIL1
  145. C
  146. IF (N1 .EQ. N2 ) THEN
  147. GOTO 1000
  148. ENDIF
  149.  
  150. C
  151. C
  152. C
  153. SEGDES IPT2,IPT3
  154. C
  155. CALL FUITE2(MELEME,N1,N2)
  156. C
  157. C
  158. C
  159. SEGDES MELEME
  160. SEGSUP MPACTIF
  161. RETURN
  162. C
  163. C gestion des erreurs
  164. C
  165. 1000 CONTINUE
  166. NBELEM = 0
  167. NBREF = 0
  168. NBNN = 0
  169. NBSOUS = 0
  170. SEGINI IPT4,IPT5
  171. IPT4.ITYPEL=2
  172. IPT5.ITYPEL=2
  173. C
  174. SEGDES MELEME,IPT4,IPT5
  175. SEGSUP MPACTIF
  176. C
  177. CALL ECROBJ('MAILLAGE',IPT4)
  178. CALL ECROBJ('MAILLAGE',IPT5)
  179. CALL ECROBJ('MAILLAGE',MELEME)
  180. C
  181. RETURN
  182. END
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  

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