doubl1
C DOUBL1 SOURCE BP208322 16/11/18 21:16:30 9177 C---------------------------------------------------- C C DÉTECTION DES ÉLÉMENTS EN DOUBLON D'UN MAILLAGE C C---------------------------------------------------- C C Création : Pascal Maugis, 04/08/2005 C C---------------------------------------------------- C C Appelé par VERMAI C C Entrée : C MELEME : maillage C C Sortie : C NMESH : nombre de doubons détectés et nommés C C---------------------------------------------------- C C Variables C C CHAIN1 : le nom de la maille à nommer, C pas plus de 999999 C C---------------------------------------------------- IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCGEOME -INC SMELEME -INC SMLENTI -INC SMLREEL C CHARACTER*8 CHAIN1 C SEGACT,MELEME NMESH=0 C C BOUCLE SUR LES ZONES DU MAILLAGE C IPT1=MELEME DO IZON=1,MAX(1,LISOUS(/1)) IF (LISOUS(/1).NE.0) THEN IPT1=LISOUS(IZON) SEGACT,IPT1 ENDIF MBELEM = IPT1.NUM(/2) NBNN = IPT1.NUM(/1) ITYP = IPT1.ITYPEL C Il faut qu'il y ait quelque chose à trier IF ((MBELEM.GT.1).AND.(NBNN.GT.0)) THEN C C tri préalable des points de chaque élément surfacique C selon la somme des numéros de noeud C JG=MBELEM SEGINI,MLENT1,MLENTI DO IE2=1,MBELEM MLENTI.LECT(IE2)=IE2 MLENT1.LECT(IE2)=0 DO IE3=1,NBNN MLENT1.LECT(IE2)=MLENT1.LECT(IE2)+IPT1.NUM(IE3,IE2) ENDDO ENDDO SEGINI,MLENT2=MLENTI C C Quand on trouve une occurence multiple, C on permute les indices dans la liste MLENTI.LECT > MLENT1.LECT,MLENT2.LECT,MLENTI.LECT) C C NOTIFICATION ET SAUVEGARDE DES MAILLES EN DOUBLE DO IE2=1,MBELEM IF(LECT(IE2).NE.0)THEN IF(LECT(IE2).NE.IE2)THEN C un multiplon détecté write(IOIMP,*) 'AVERTISSEMENT : ', & ' une maille de type ',NOMS(ITYP), & ' figure ',(LECT(IE2)-IE2+1), & ' fois dans la sous-zone ',IZON DO IE4=IE2,LECT(IE2) LECT(IE4)=0 C Création d'une maille nommée C ---------------------------- CHAIN1='MESH' NMESH=NMESH+1 C chaîne de caractères du nom de la maille NNO=NMESH IF (NNO.LE.9) THEN WRITE(CHAIN1(5:5),FMT='(I1)')NNO ELSEif(NNO.LE.99) THEN WRITE(CHAIN1(5:6),FMT='(I2)')NNO ELSEif(NNO.LE.999) THEN WRITE(CHAIN1(5:7),FMT='(I3)')NNO ELSEif(NNO.LE.9999) THEN WRITE(CHAIN1(5:8),FMT='(I4)')NNO ELSEif(NNO.LE.99999) THEN WRITE(CHAIN1(4:8),FMT='(I5)')NNO ELSEif(NNO.LE.999999) THEN WRITE(CHAIN1(3:8),FMT='(I6)')NNO ELSE C Numéro du point ou de l'élément trop grand ENDIF C Maillage à UN élément NBELEM=1 NBSOUS=0 NBREF=0 SEGINI,IPT3 DO IE3=1,NBNN IPT3.NUM(IE3,1)=IPT1.NUM(IE3,IE4) ENDDO IPT3.ICOLOR(1)=IPT1.ICOLOR(IE4) SEGDES,IPT3 C Message : write(IOIMP,*) ' maille concernée : ',CHAIN1 ENDDO ENDIF ENDIF ENDDO SEGSUP,MLENTI,MLENT1,MLENT2 ENDIF C C FIN BOUCLE SUR LES ZONES DU MAILLAGE C SEGDES,IPT1 ENDDO RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales