Télécharger la plaquette Cast3M


fr en

Télécharger doubl1.eso

Retour à la liste

Numérotation des lignes : 

doubl1

  1. C DOUBL1    SOURCE    BP208322  16/11/18    21:16:30     9177           
  2.       SUBROUTINE DOUBL1(MELEME,NMESH)
  3. C----------------------------------------------------
  4. C
  5. C     DÉTECTION DES ÉLÉMENTS EN DOUBLON D'UN MAILLAGE
  6. C
  7. C----------------------------------------------------
  8. C
  9. C     Création : Pascal Maugis, 04/08/2005
  10. C
  11. C----------------------------------------------------
  12. C
  13. C     Appelé par VERMAI
  14. C
  15. C     Entrée :
  16. C       MELEME : maillage
  17. C
  18. C     Sortie :
  19. C       NMESH : nombre de doubons détectés et nommés
  20. C
  21. C----------------------------------------------------
  22. C
  23. C     Variables
  24. C
  25. C       CHAIN1 : le nom de la maille à nommer,
  26. C                pas plus de 999999
  27. C
  28. C----------------------------------------------------
  29.       IMPLICIT INTEGER(I-N)
  30.       IMPLICIT REAL*8(A-H,O-Z)
  31.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC CCGEOME
  35. -INC SMELEME
  36. -INC SMLENTI
  37. -INC SMLREEL
  38. C
  39.       CHARACTER*8 CHAIN1
  40. C
  41.       SEGACT,MELEME
  42.       NMESH=0
  43. C
  44. C     BOUCLE SUR LES ZONES DU MAILLAGE
  45. C
  46.       IPT1=MELEME
  47.       DO IZON=1,MAX(1,LISOUS(/1))
  48.         IF (LISOUS(/1).NE.0) THEN
  49.           IPT1=LISOUS(IZON)
  50.           SEGACT,IPT1
  51.         ENDIF
  52.  
  53.         MBELEM = IPT1.NUM(/2)
  54.         NBNN   = IPT1.NUM(/1)
  55.         ITYP   = IPT1.ITYPEL
  56.  
  57. C       Il faut qu'il y ait quelque chose à trier
  58.         IF ((MBELEM.GT.1).AND.(NBNN.GT.0)) THEN
  59. C
  60. C         tri préalable des points de chaque élément surfacique
  61. C         selon la somme des numéros de noeud
  62. C
  63.           JG=MBELEM
  64.           SEGINI,MLENT1,MLENTI
  65.           DO IE2=1,MBELEM
  66.             MLENTI.LECT(IE2)=IE2
  67.             MLENT1.LECT(IE2)=0
  68.             DO IE3=1,NBNN
  69.               MLENT1.LECT(IE2)=MLENT1.LECT(IE2)+IPT1.NUM(IE3,IE2)
  70.             ENDDO
  71.           ENDDO
  72.           SEGINI,MLENT2=MLENTI
  73.           CALL GENOR2(MLENT1.LECT,MLENT2.LECT,MBELEM)
  74. C
  75. C         Quand on trouve une occurence multiple,
  76. C         on permute les indices dans la liste MLENTI.LECT
  77.           CALL DOUBL4(IPT1.NUM,NBNN,MBELEM,
  78.      >                MLENT1.LECT,MLENT2.LECT,MLENTI.LECT)
  79. C
  80. C         NOTIFICATION ET SAUVEGARDE DES MAILLES EN DOUBLE
  81.           DO IE2=1,MBELEM
  82.             IF(LECT(IE2).NE.0)THEN
  83.               IF(LECT(IE2).NE.IE2)THEN
  84. C               un multiplon détecté
  85.                 write(IOIMP,*) 'AVERTISSEMENT : ',
  86.      &               ' une maille de type ',NOMS(ITYP),
  87.      &               ' figure ',(LECT(IE2)-IE2+1),
  88.      &               ' fois dans la sous-zone ',IZON
  89.  
  90.                 DO IE4=IE2,LECT(IE2)
  91.                   LECT(IE4)=0
  92.  
  93. C                 Création d'une maille nommée
  94. C                 ----------------------------
  95.                   CHAIN1='MESH'
  96.                   NMESH=NMESH+1
  97. C                 chaîne de caractères du nom de la maille
  98.                   NNO=NMESH
  99.                   IF (NNO.LE.9) THEN
  100.                      WRITE(CHAIN1(5:5),FMT='(I1)')NNO
  101.                   ELSEif(NNO.LE.99) THEN
  102.                      WRITE(CHAIN1(5:6),FMT='(I2)')NNO
  103.                   ELSEif(NNO.LE.999) THEN
  104.                      WRITE(CHAIN1(5:7),FMT='(I3)')NNO
  105.                   ELSEif(NNO.LE.9999) THEN
  106.                      WRITE(CHAIN1(5:8),FMT='(I4)')NNO
  107.                   ELSEif(NNO.LE.99999) THEN
  108.                      WRITE(CHAIN1(4:8),FMT='(I5)')NNO
  109.                   ELSEif(NNO.LE.999999) THEN
  110.                      WRITE(CHAIN1(3:8),FMT='(I6)')NNO
  111.                   ELSE
  112. C                   Numéro du point ou de l'élément trop grand
  113.                     CALL ERREUR(262)
  114.                   ENDIF
  115.  
  116. C                 Maillage à UN élément
  117.                   NBELEM=1
  118.                   NBSOUS=0
  119.                   NBREF=0
  120.                   SEGINI,IPT3
  121.                   DO IE3=1,NBNN
  122.                     IPT3.NUM(IE3,1)=IPT1.NUM(IE3,IE4)
  123.                   ENDDO
  124.                   IPT3.ICOLOR(1)=IPT1.ICOLOR(IE4)
  125.                   SEGDES,IPT3
  126.                   CALL NOMOBJ('MAILLAGE',CHAIN1,IPT3)
  127.  
  128. C                 Message :
  129.                   write(IOIMP,*) '  maille concernée : ',CHAIN1
  130.                 ENDDO
  131.               ENDIF
  132.             ENDIF
  133.           ENDDO
  134.  
  135.           SEGSUP,MLENTI,MLENT1,MLENT2
  136.         ENDIF
  137. C
  138. C       FIN BOUCLE SUR LES ZONES DU MAILLAGE
  139. C
  140.         SEGDES,IPT1
  141.       ENDDO
  142.  
  143.       RETURN
  144.       END
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  

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