1 : C DOUBL1 SOURCE CHAT 07/10/29 21:18:20 5940 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 : -INC CCOPTIO 32 : -INC CCGEOME 33 : -INC SMELEME 34 : -INC SMLENTI 35 : -INC SMLREEL 36 : C 37 : CHARACTER*8 CHAIN1 38 : C 39 : SEGACT,MELEME 40 : NMESH=0 41 : C 42 : C BOUCLE SUR LES ZONES DU MAILLAGE 43 : C 44 : IPT1=MELEME 45 : DO IZON=1,MAX(1,LISOUS(/1)) 46 : IF (LISOUS(/1).NE.0) THEN 47 : IPT1=LISOUS(IZON) 48 : SEGACT,IPT1 49 : ENDIF 50 : 51 : MBELEM = IPT1.NUM(/2) 52 : NBNN = IPT1.NUM(/1) 53 : ITYP = IPT1.ITYPEL 54 : 55 : C Il faut qu'il y ait quelque chose à trier 56 : IF ((MBELEM.GT.1).AND.(NBNN.GT.0)) THEN 57 : C 58 : C tri préalable des points de chaque élément surfacique 59 : C selon la somme des numéros de noeud 60 : C 61 : JG=MBELEM 62 : SEGINI,MLENT1,MLENTI 63 : DO IE2=1,MBELEM 64 : MLENTI.LECT(IE2)=IE2 65 : MLENT1.LECT(IE2)=0 66 : DO IE3=1,NBNN 67 : MLENT1.LECT(IE2)=MLENT1.LECT(IE2)+IPT1.NUM(IE3,IE2) 68 : ENDDO 69 : ENDDO 70 : SEGINI,MLENT2=MLENTI 70 : CALL GENOR2(MLENT1.LECT,MLENT2.LECT,MBELEM) 71 : C 72 : C Quand on trouve une occurence multiple, 73 : C on permute les indices dans la liste MLENTI.LECT 73 : CALL DOUBL4(IPT1.NUM,NBNN,MBELEM, 74 : > MLENT1.LECT,MLENT2.LECT,MLENTI.LECT) 75 : C 76 : C NOTIFICATION ET SAUVEGARDE DES MAILLES EN DOUBLE 77 : DO IE2=1,MBELEM 78 : IF(LECT(IE2).NE.0)THEN 79 : IF(LECT(IE2).NE.IE2)THEN 80 : C un multiplon détecté 81 : write(IOIMP,*) 'AVERTISSEMENT : ', 82 : & ' une maille de type ',NOMS(ITYP), 83 : & ' figure ',(LECT(IE2)-IE2+1), 84 : & ' fois dans la sous-zone ',IZON 85 : 86 : DO IE4=IE2,LECT(IE2) 87 : LECT(IE4)=0 88 : 89 : C Création d'une maille nommée 90 : C ---------------------------- 91 : CHAIN1='MESH' 92 : NMESH=NMESH+1 93 : C chaîne de caractères du nom de la maille 94 : NNO=NMESH 95 : IF (NNO.LE.9) THEN 96 : WRITE(CHAIN1(5:5),FMT='(I1)')NNO 97 : ELSEif(NNO.LE.99) THEN 98 : WRITE(CHAIN1(5:6),FMT='(I2)')NNO 99 : ELSEif(NNO.LE.999) THEN 100 : WRITE(CHAIN1(5:7),FMT='(I3)')NNO 101 : ELSEif(NNO.LE.9999) THEN 102 : WRITE(CHAIN1(5:8),FMT='(I4)')NNO 103 : ELSEif(NNO.LE.99999) THEN 104 : WRITE(CHAIN1(4:8),FMT='(I5)')NNO 105 : ELSEif(NNO.LE.999999) THEN 106 : WRITE(CHAIN1(3:8),FMT='(I6)')NNO 107 : ELSE 108 : C Numéro du point ou de l'élément trop grand 108 : CALL ERREUR(262) 109 : ENDIF 110 : 111 : C Maillage à UN élément 112 : NBELEM=1 113 : NBSOUS=0 114 : NBREF=0 115 : SEGINI,IPT3 116 : DO IE3=1,NBNN 117 : IPT3.NUM(IE3,1)=IPT1.NUM(IE3,IE4) 118 : ENDDO 119 : IPT3.ICOLOR(1)=IPT1.ICOLOR(IE4) 120 : SEGDES,IPT3 120 : CALL NOMOBJ('MAILLAGE',CHAIN1,IPT3) 121 : 122 : C Message : 123 : write(IOIMP,*) ' maille concernée : ',CHAIN1 124 : ENDDO 125 : ENDIF 126 : ENDIF 127 : ENDDO 128 : 129 : SEGSUP,MLENTI,MLENT1,MLENT2 130 : ENDIF 131 : C 132 : C FIN BOUCLE SUR LES ZONES DU MAILLAGE 133 : C 134 : SEGDES,IPT1 135 : ENDDO 136 : 137 : RETURN 138 : END 139 : 140 : 141 : 142 : 143 : 144 :
© Cast3M 2003 - All rights reserved.
Disclaimer