Télécharger la plaquette Cast3M


fr en

Télécharger doubl3.eso

Retour à la liste

Numérotation des lignes : 

doubl3

  1. C DOUBL3    SOURCE    BP208322  16/11/18    21:16:31     9177           
  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.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC CCGEOME
  34. -INC SMELEME
  35. -INC SMLENTI
  36. C
  37.       LOGICAL BAVARD
  38. C
  39. C     tri préalable des points de chaque éléments surfaciques
  40. C     selon la somme des numéros de noeud
  41. C
  42.       SEGACT,MELEME*MOD
  43.       JG=NBELEM
  44.       SEGINI,MLENT1,MLENTI
  45.       DO IE2=1,NBELEM
  46.         MLENTI.LECT(IE2)=IE2
  47.         MLENT1.LECT(IE2)=0
  48.         DO IE3=1,NBNN
  49.           MLENT1.LECT(IE2)=MLENT1.LECT(IE2)+NUM(IE3,IE2)
  50.         ENDDO
  51.       ENDDO
  52.       SEGINI,MLENT2=MLENTI
  53.       CALL GENOR2(MLENT1.LECT,MLENT2.LECT,NBELEM)
  54. C
  55. *     Quand on trouve une occurence multiple,
  56. *     on permute les indices dans la liste MLENTI.LECT
  57.       CALL DOUBL4(NUM,NBNN,NBELEM,
  58.      >            MLENT1.LECT,MLENT2.LECT,MLENTI.LECT)
  59. C
  60. C     REECRITURE DE LA SOUS-ZONE RESULTAT
  61.       ITYP=MELEME.ITYPEL
  62.       MBELEM=0
  63.       DO IE2=1,NBELEM
  64.         LIE2=LECT(IE2)
  65.         IF(LIE2.NE.0)THEN
  66.           IF(LIE2.NE.IE2)THEN
  67. *           tous les doublons de cet élément seront ignorés au prochain passage
  68.             NDBL = 0
  69.             LIE4 = LIE2
  70.             DO WHILE (LIE4.NE.IE2)
  71.               NDBL = NDBL + 1
  72.               IE5=LIE4
  73.               LIE5=LECT(IE5)
  74.               LECT(IE5)=0
  75.               IF (BAVARD)
  76.      &          write(IOIMP,*) '  maille ',IE5,' supprimee'
  77. *             on passe au doublon suivant
  78.               LIE4=LIE5
  79.             ENDDO
  80.             IF (BAVARD)
  81.      &        write(IOIMP,*) 'AVERTISSEMENT : maille ',NOMS(ITYP),
  82.      &          ' numero ',IE2,' en ',(NDBL+1),' exemplaires.'
  83.  
  84.           ENDIF
  85. *         écriture de la nouvelle maille au nouvel emplacement
  86.           MBELEM=MBELEM+1
  87.           DO IE3=1,NBNN
  88.             NUM(IE3,MBELEM) = NUM(IE3,IE2)
  89.           ENDDO
  90.           ICOLOR(MBELEM)    = ICOLOR(IE2)
  91.         ENDIF
  92.       ENDDO
  93.  
  94. C     On tronquera la fin du maillage contenant les doublons
  95.       NBELEM=MBELEM
  96.       NBSOUS=0
  97.       NBREF=LISREF(/1)
  98.       SEGADJ,MELEME
  99.  
  100.       SEGSUP,MLENTI,MLENT1,MLENT2
  101. C
  102.       RETURN
  103.       END
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales