Esope source files

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