Télécharger doubl3.eso

Retour à la liste

Numérotation des lignes :

  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. -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
  51. CALL GENOR2(MLENT1.LECT,MLENT2.LECT,NBELEM)
  52. C
  53. * Quand on trouve une occurence multiple,
  54. * on permute les indices dans la liste MLENTI.LECT
  55. CALL DOUBL4(NUM,NBNN,NBELEM,
  56. > MLENT1.LECT,MLENT2.LECT,MLENTI.LECT)
  57. C
  58. C REECRITURE DE LA SOUS-ZONE RESULTAT
  59. ITYP=MELEME.ITYPEL
  60. MBELEM=0
  61. DO IE2=1,NBELEM
  62. LIE2=LECT(IE2)
  63. IF(LIE2.NE.0)THEN
  64. IF(LIE2.NE.IE2)THEN
  65. * tous les doublons de cet élément seront ignorés au prochain passage
  66. NDBL = 0
  67. LIE4 = LIE2
  68. DO WHILE (LIE4.NE.IE2)
  69. NDBL = NDBL + 1
  70. IE5=LIE4
  71. LIE5=LECT(IE5)
  72. LECT(IE5)=0
  73. IF (BAVARD)
  74. & write(IOIMP,*) ' maille ',IE5,' supprimee'
  75. * on passe au doublon suivant
  76. LIE4=LIE5
  77. ENDDO
  78. IF (BAVARD)
  79. & write(IOIMP,*) 'AVERTISSEMENT : maille ',NOMS(ITYP),
  80. & ' numero ',IE2,' en ',(NDBL+1),' exemplaires.'
  81.  
  82. ENDIF
  83. * écriture de la nouvelle maille au nouvel emplacement
  84. MBELEM=MBELEM+1
  85. DO IE3=1,NBNN
  86. NUM(IE3,MBELEM) = NUM(IE3,IE2)
  87. ENDDO
  88. ICOLOR(MBELEM) = ICOLOR(IE2)
  89. ENDIF
  90. ENDDO
  91.  
  92. C On tronquera la fin du maillage contenant les doublons
  93. NBELEM=MBELEM
  94. NBSOUS=0
  95. NBREF=LISREF(/1)
  96. SEGADJ,MELEME
  97.  
  98. SEGSUP,MLENTI,MLENT1,MLENT2
  99. C
  100. RETURN
  101. END
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  

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