Esope source files

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