Télécharger la plaquette Cast3M


fr en

Télécharger fuite1.eso

Retour à la liste

Numérotation des lignes : 

fuite1

  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