Sources Esope | Cast3M

fuite2
C FUITE2    SOURCE    CHAT      05/01/13    00:11:33     5004
      SUBROUTINE FUITE2(MELEME,N1,N2)
C
C  FONCTION: SECONDE  PARTIE DE L'OPÉRATEUR FUITE
C            scinde le contour meleme avec l'elemen t de fuite dont les
C            extrémités sont N1 et N2.
C
C  ENTREES:
C           MELEME  contour fermé orienté forme uniquement de seg2
C           N1 # du point extrémité de l'élément de fuite
C           N2 # du point extrémité de l'élément de fuite
C
C  SORTIES:
C           avec ECROBJ
C
C
C A de Gayffier
C
C FORTRAN + ESOPE
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC SMELEME
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
C
C    ce segment contient les couples de points de MAIL5 et MAIL6
C
      SEGMENT MAILRES
          INTEGER NMAIL5(NBEL,2),NMAIL6(NBEL,2)
      ENDSEGMENT
C
C  creation de MAIL5 qui contient le segment N1->N2
C
      NBEL = NUM(/2)
      SEGINI MAILRES
C
      NMAIL5(1,1)=N1
      NMAIL5(1,2)=N2
C
      NBEL5 = 1
 100  IF (NMAIL5(NBEL5,2) .NE. NMAIL5(1,1)) THEN
        DO 110 I=1,NUM(/2)
          IF (NMAIL5(NBEL5,2) .EQ. NUM(1,I)) THEN
            NBEL5 = NBEL5 + 1
            NMAIL5(NBEL5,1)=NUM(1,I)
            NMAIL5(NBEL5,2)=NUM(2,I)
            GOTO 100
          ENDIF
 110    CONTINUE
C
C    le contour n'est pas fermé
C
        R = ABS(XCOOR((NMAIL5(NBEL5,2)-1)*(IDIM+1)+1))
        DENS = MAX(XCOOR((NMAIL5(NBEL5,2)-1)*(IDIM+1)),1.D-10)
C
C    est on en axisymétrique
C
        IF (IFOUR .EQ. 0 .AND. R .LT. DENS) GOTO 1000
C
C       Le contour n'est pas fermé
C
        CALL ERREUR(28)
        SEGSUP MAILRES
        RETURN
      ENDIF
C
C
C  creation de MAIL6 qui contient le segment N2->N1
C
C
 200  CONTINUE
      NMAIL6(1,1)=N2
      NMAIL6(1,2)=N1
C
      NBEL6 = 1
 210  IF (NMAIL6(NBEL6,2) .NE. NMAIL6(1,1)) THEN
        DO 220 I=1,NUM(/2)
          IF (NMAIL6(NBEL6,2) .EQ. NUM(1,I)) THEN
            NBEL6 = NBEL6 + 1
            NMAIL6(NBEL6,1)=NUM(1,I)
            NMAIL6(NBEL6,2)=NUM(2,I)
            GOTO 210
          ENDIF
 220    CONTINUE
C
C    le contour n'est pas fermé
C
        R = ABS(XCOOR((NMAIL6(NBEL6,2)-1)*(IDIM+1)+1))
        DENS = MAX(XCOOR((NMAIL6(NBEL6,2)-1)*(IDIM+1)),1.D-10)
C
C    est on en axisymétrique
C
        IF (IFOUR .EQ. 0 .AND. R .LT. DENS) GOTO 2000
C
C       Le contour n'est pas fermé
C
        CALL ERREUR(28)
        SEGSUP MAILRES
        RETURN
      ENDIF
C
C
C   ecriture des maillage
C
C
 300  CONTINUE
C
      NBREF = 0
      NBSOUS = 0
      NBNN = 2
      NBELEM = 1
      SEGINI IPT4
      IPT4.ITYPEL = 2
      IPT4.NUM(1,1) = N1
      IPT4.NUM(2,1) = N2
C
      NBELEM = NBEL5
      SEGINI IPT5
      IPT5.ITYPEL = 2
      DO 310 I=1,NBEL5
        IPT5.NUM(1,I) = NMAIL5(I,1)
        IPT5.NUM(2,I) = NMAIL5(I,2)
 310  CONTINUE
C
      NBELEM = NBEL6
      SEGINI IPT6
      IPT6.ITYPEL = 2
      DO 320 I=1,NBEL6
        IPT6.NUM(1,I) = NMAIL6(I,1)
        IPT6.NUM(2,I) = NMAIL6(I,2)
 320  CONTINUE
C
      CALL ECROBJ('MAILLAGE',IPT6)
      CALL ECROBJ('MAILLAGE',IPT5)
      CALL ECROBJ('MAILLAGE',IPT4)
C
      SEGDES IPT4,IPT5,IPT6
      SEGSUP MAILRES
      RETURN
C
C==============================================================
C                AXISYMMETRIQUE
C  mail5
C
 1000 CONTINUE
C
C     le point extrème est sur l'axe, et on en axisymetrique
C     on parcours le contour dans l'autre sens
      NBELI = 1
 1010 CONTINUE
      DO 1020 I=1,NUM(/2)
        IF (NMAIL5(NBELI,1) .EQ. NUM(2,I)) THEN
            NBEL5 = NBEL5 + 1
            NBELI = NBEL5
            NMAIL5(NBEL5,1)=NUM(1,I)
            NMAIL5(NBEL5,2)=NUM(2,I)
            GOTO 1010
        ENDIF
 1020 CONTINUE
C
C
C
      R = ABS(XCOOR((NMAIL5(NBEL5,1)-1)*(IDIM+1)+1))
      DENS = MAX(XCOOR((NMAIL5(NBEL5,1)-1)*(IDIM+1)),1.D-10)
      IF (R .GT. DENS) THEN
         CALL ERREUR(28)
         SEGSUP MAILRES
         RETURN
      ENDIF
      GOTO 200
C
C  mail6 en axisymétrique
C
 2000 CONTINUE
C
C     le point extrème est sur l'axe, et on en axisymetrique
C     on parcours le contour dans l'autre sens
      NBELI = 1
 2010 CONTINUE
      DO 2020 I=1,NUM(/2)
        IF (NMAIL6(NBELI,1) .EQ. NUM(2,I)) THEN
            NBEL6 = NBEL6 + 1
            NBELI = NBEL6
            NMAIL6(NBEL6,1)=NUM(1,I)
            NMAIL6(NBEL6,2)=NUM(2,I)
            GOTO 2010
        ENDIF
 2020 CONTINUE
C
C
C
      R = ABS(XCOOR((NMAIL6(NBEL6,1)-1)*(IDIM+1)+1))
      DENS = MAX(XCOOR((NMAIL6(NBEL6,1)-1)*(IDIM+1)),1.D-10)
      IF (R .GT. DENS) THEN
         CALL ERREUR(28)
         SEGSUP MAILRES
         RETURN
      ENDIF
      GOTO 300
C
      END