Esope source files

   1 : C DOUBL3    SOURCE    CHAT      07/10/29    21:18:24     5940           
   2 :       SUBROUTINE DOUBL3(MELEME,NBELEM,NBNN,BAVARD)
   3 : C----------------------------------------------------
   4 : C
   5 : C     ELIMINATION DES ÉLÉMENTS EN DOUBLON D'UN MAILLAGE
   6 : C
   7 : C----------------------------------------------------
   8 : C
   9 : C     Création : tiré originellement de coupe.eso
  10 : C
  11 : C     Modification : Pascal Maugis 28/7/2005
  12 : C       Extension à des occurences multiples et non simplement doubles
  13 : C
  14 : C----------------------------------------------------
  15 : C
  16 : C     Appelé par DOUBL2
  17 : C
  18 : C     Entrée :
  19 : C       MELEME : élémentaire ACTIVE
  20 : C       NBELEM
  21 : C       NBNN
  22 : C
  23 : C
  24 : C     Sortie
  25 : C       MELEME : modifié ACTIVE
  26 : C
  27 : C----------------------------------------------------
  28 :       IMPLICIT INTEGER(I-N)
  29 :       IMPLICIT REAL*8(A-H,O-Z)
  30 : -INC CCOPTIO
  31 : -INC CCGEOME
  32 : -INC SMELEME
  33 : -INC SMLENTI
  34 : C
  35 :       LOGICAL BAVARD
  36 : C
  37 : C     tri préalable des points de chaque éléments surfaciques
  38 : C     selon la somme des numéros de noeud
  39 : C
  40 :       SEGACT,MELEME*MOD
  41 :       JG=NBELEM
  42 :       SEGINI,MLENT1,MLENTI
  43 :       DO IE2=1,NBELEM
  44 :         MLENTI.LECT(IE2)=IE2
  45 :         MLENT1.LECT(IE2)=0
  46 :         DO IE3=1,NBNN
  47 :           MLENT1.LECT(IE2)=MLENT1.LECT(IE2)+NUM(IE3,IE2)
  48 :         ENDDO
  49 :       ENDDO
  50 :       SEGINI,MLENT2=MLENTI
  50 :       CALL GENOR2(MLENT1.LECT,MLENT2.LECT,NBELEM)
  51 : C
  52 : *     Quand on trouve une occurence multiple,
  53 : *     on permute les indices dans la liste MLENTI.LECT
  53 :       CALL DOUBL4(NUM,NBNN,NBELEM,
  54 :      >            MLENT1.LECT,MLENT2.LECT,MLENTI.LECT)
  55 : C
  56 : C     REECRITURE DE LA SOUS-ZONE RESULTAT
  57 :       ITYP=MELEME.ITYPEL
  58 :       MBELEM=0
  59 :       DO IE2=1,NBELEM
  60 :         LIE2=LECT(IE2)
  61 :         IF(LIE2.NE.0)THEN
  62 :           IF(LIE2.NE.IE2)THEN
  63 : *           tous les doublons de cet élément seront ignorés au prochain passage
  64 :             NDBL = 0
  65 :             LIE4 = LIE2
  66 :             DO WHILE (LIE4.NE.IE2)
  67 :               NDBL = NDBL + 1
  68 :               IE5=LIE4
  69 :               LIE5=LECT(IE5)
  70 :               LECT(IE5)=0
  71 :               IF (BAVARD)
  72 :      &          write(IOIMP,*) '  maille ',IE5,' supprimee'
  73 : *             on passe au doublon suivant
  74 :               LIE4=LIE5
  75 :             ENDDO
  76 :             IF (BAVARD)
  77 :      &        write(IOIMP,*) 'AVERTISSEMENT : maille ',NOMS(ITYP),
  78 :      &          ' numero ',IE2,' en ',(NDBL+1),' exemplaires.'
  79 : 
  80 :           ENDIF
  81 : *         écriture de la nouvelle maille au nouvel emplacement
  82 :           MBELEM=MBELEM+1
  83 :           DO IE3=1,NBNN
  84 :             NUM(IE3,MBELEM) = NUM(IE3,IE2)
  85 :           ENDDO
  86 :           ICOLOR(MBELEM)    = ICOLOR(IE2)
  87 :         ENDIF
  88 :       ENDDO
  89 : 
  90 : C     On tronquera la fin du maillage contenant les doublons
  91 :       NBELEM=MBELEM
  92 :       NBSOUS=0
  93 :       NBREF=LISREF(/1)
  94 :       SEGADJ,MELEME
  95 : 
  96 :       SEGSUP,MLENTI,MLENT1,MLENT2
  97 : C
  98 :       RETURN
  99 :       END
 100 : 
 101 : 
 102 : 
 103 :  
 104 :