1 : C LE2ME2 SOURCE CHAT 05/01/13 01:14:16 5004 2 : SUBROUTINE LE2ME2(MLELEM,MELEME,MCENEL) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C NOM : LE2ME2 7 : C DESCRIPTION : Construit un MELEME d'éléments POLY à 8 : C partir d'une liste séquentielle indexée d'éléments 9 : C voir le segment MLELEM 10 : C En gros, on regroupe les éléments qui ont le meme 11 : C nombre de points. 12 : C 13 : C LANGAGE : ESOPE 14 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) 15 : C mél : gounand@semt2.smts.cea.fr 16 : C*********************************************************************** 17 : C APPELES : - 18 : C APPELES (Outils) : - ERREUR 19 : C APPELES (BLAS) : - 20 : C APPELES (CALCUL) : - 21 : C*********************************************************************** 22 : C SYNTAXE GIBIANE : - 23 : C ENTREES : MLELEM (type MLELEM) : liste séquentielle 24 : C indexée d'éléments 25 : C ENTREES/SORTIES : - 26 : C SORTIES : MELEME ( " MELEME) : maillage de POLY 27 : C associé aux entrées. 28 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 29 : C*********************************************************************** 30 : C VERSION : v1, 08/10/98, version initiale 31 : C HISTORIQUE : v1, 08/10/98, création 32 : C HISTORIQUE : 11.04.2000 Petit modif et ajout de qqc commentaire (A.B.) 33 : C HISTORIQUE : 34 : C*********************************************************************** 35 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 36 : C en cas de modification de ce sous-programme afin de faciliter 37 : C la maintenance ! 38 : C*********************************************************************** 39 : -INC CCOPTIO 40 : -INC SMELEME 41 : -INC SMLENTI 42 : POINTEUR PONBEL.MLENTI 43 : POINTEUR MTYPL.MLENTI 44 : POINTEUR MCENEL.MELEME 45 : * 46 : * Segment MLELEM 47 : * 48 : SEGMENT MLELEM 49 : INTEGER INDEX(NBL+1) 50 : INTEGER LESPOI(NBTPOI) 51 : ENDSEGMENT 52 : * 53 : * LISTE SEQUENTIELLE INDEXEE D'ELEMENTS 54 : * 55 : * NBL : NOMBRE D'ELEMENTS 56 : * NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES 57 : * INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT 58 : * DANS LE TABLEAU LESPOI 59 : * LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS 60 : * DU IEME ELEMENT 61 : * 62 : C 63 : C**** Variables de COOPTIO 64 : C 65 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 66 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 67 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 68 : C & ,IECHO, IIMPI, IOSPI 69 : C & ,IDIM 70 : C & ,MCOORD 71 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 72 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 73 : C & ,NORINC,NORVAL,NORIND,NORVAD 74 : C & ,NUCROU, IPSAUV 75 : C 76 : INTEGER JG,NBL,MAXPOI,INBL,NONOEU,NBSOUS,NBNN 77 : & ,NBELEM,NBREF,INBEL,NBNOEU,INBSO,IELEM 78 : & ,IDELEM,ITEST,IMAXPO,INBNN,NTYPL 79 : * 80 : * Executable statements 81 : * 82 : SEGACT MLELEM 83 : NBL=MLELEM.INDEX(/1)-1 84 : * 85 : * On construit le tableau temporaire PONBEL tel que : 86 : * PONBEL(I) : NOMBRE DE POINTS DU IEME ELEMENT DE MLELEM 87 : * 88 : * On calcule aussi le maximum du nombre de points des éléments de 89 : * MLELEM. 90 : * 91 : JG=NBL 92 : SEGINI PONBEL 93 : MAXPOI=0 94 : DO 1 INBL=1,NBL 95 : PONBEL.LECT(INBL)=MLELEM.INDEX(INBL+1)-MLELEM.INDEX(INBL) 96 : MAXPOI=MAX(MAXPOI,PONBEL.LECT(INBL)) 97 : 1 CONTINUE 98 : * 99 : * Maintenant on détermine le nombre de sous-objets (LISOUS) 100 : * que devra comporter MELEME, cad le nombre de type d'éléments 101 : * différents (distingués par le nombre de noeuds) 102 : * MTYPL(NONOEU) contient le nombre d'éléments de MLELEM ayant 103 : * NONOEU noeuds (éventuellement nul). 104 : * NTYPL contient le nombre de type d'éléments différents 105 : * à créer. 106 : * 107 : JG=MAXPOI 108 : SEGINI MTYPL 109 : DO 2 INBL=1,NBL 110 : NONOEU=PONBEL.LECT(INBL) 111 : MTYPL.LECT(NONOEU)=MTYPL.LECT(NONOEU)+1 112 : 2 CONTINUE 113 : NTYPL=0 114 : DO 3 IMAXPO=1,MAXPOI 115 : IF (MTYPL.LECT(IMAXPO).NE.0) NTYPL=NTYPL+1 116 : 3 CONTINUE 117 : C 118 : C********** ITEST: variable de test; a la fin ITEST = nombre total de 119 : C centre NBL 120 : C 121 : ITEST = 0 122 : * 123 : * On construit le maillage de centre du MELEME centre-voisins 124 : * 125 : NBSOUS = 0 126 : NBNN = 1 127 : NBELEM = NBL 128 : NBREF = 0 129 : SEGINI MCENEL 130 : * Type d'élément : POI1 (cf. bdata.eso) 131 : MCENEL.ITYPEL = 1 132 : * 133 : * On construit le MELEME en distinguant le cas NTYPL=1... 134 : * 135 : IF (NTYPL.EQ.1) THEN 136 : NBSOUS=0 137 : NBNN=MAXPOI 138 : NBELEM=NBL 139 : NBREF=0 140 : SEGINI MELEME 141 : * Type d'élément : POLY (cf. bdata.eso) 142 : MELEME.ITYPEL=32 143 : DO 5 INBEL=1,NBL 144 : ITEST = ITEST + 1 145 : IDELEM=MLELEM.INDEX(INBEL) 146 : C 147 : C********** IDELEM = position du centre INBEL 148 : C IDELEM+1,...,MAXPOI: position de ses voisins 149 : C 150 : DO 52 INBNN=1,MAXPOI-1 151 : MELEME.NUM(INBNN,INBEL)=MLELEM.LESPOI(IDELEM+INBNN) 152 : 52 CONTINUE 153 : C 154 : C********** On met le centre INBEL au dernier 155 : C 156 : MELEME.NUM(MAXPOI,INBEL)=MLELEM.LESPOI(IDELEM) 157 : MCENEL.NUM(1,ITEST)=MLELEM.LESPOI(IDELEM) 158 : 5 CONTINUE 159 : SEGDES MELEME 160 : ELSE 161 : NBSOUS=NTYPL 162 : NBNN=0 163 : NBELEM=0 164 : NBREF=0 165 : SEGINI MELEME 166 : NBNOEU=0 167 : DO 7 INBSO=1,NTYPL 168 : * On cherche le nombre de noeuds du type d'éléments suivant 169 : NBNOEU=NBNOEU+1 170 : 72 CONTINUE 171 : IF (MTYPL.LECT(NBNOEU).EQ.0) THEN 172 : NBNOEU=NBNOEU+1 173 : GOTO 72 174 : ENDIF 175 : NBSOUS=0 176 : * On stockera le centre en dernier 177 : NBNN=NBNOEU 178 : NBELEM=MTYPL.LECT(NBNOEU) 179 : NBREF=0 180 : SEGINI IPT1 181 : IPT1.ITYPEL=32 182 : IELEM=0 183 : DO 74 INBEL=1,NBELEM 184 : ITEST=ITEST+1 185 : C 186 : C************* Test: on change de couleur a quelque elts pour le 187 : C visualizer 188 : C 189 : C IF(ITEST .EQ. 1) IPT1.ICOLOR(INBEL) = 2 190 : C 191 : C************* FIN TEST 192 : C 193 : IELEM=IELEM+1 194 : 742 CONTINUE 195 : IF (PONBEL.LECT(IELEM).NE.NBNOEU) THEN 196 : C 197 : C**************** L'elt considerée n'a pas NBNOEU points 198 : C donc on passe au suivant 199 : C 200 : IELEM=IELEM+1 201 : GOTO 742 202 : ENDIF 203 : IDELEM = MLELEM.INDEX(IELEM) 204 : C 205 : C************* IDELEM = position du centre IELEM 206 : C IDELEM+1,...,IDELEM+NBNN: position de ses voisins 207 : C 208 : DO 744 INBNN=1,NBNN-1 209 : IPT1.NUM(INBNN,INBEL)=MLELEM.LESPOI(IDELEM+INBNN) 210 : 744 CONTINUE 211 : C 212 : C************* On stockera le centre en dernier 213 : C 214 : IPT1.NUM(NBNN,INBEL)=MLELEM.LESPOI(IDELEM) 215 : MCENEL.NUM(1,ITEST)=MLELEM.LESPOI(IDELEM) 216 : 74 CONTINUE 217 : SEGDES IPT1 218 : MELEME.LISOUS(INBSO)=IPT1 219 : 7 CONTINUE 220 : SEGDES MELEME 221 : ENDIF 222 : IF(ITEST .NE. NBL)THEN 223 : MOTERR(1:40) = 'Subroutine le2me2.eso ' 224 : WRITE(IOIMP,*) MOTERR(1:40) 225 : C 226 : C******* Message d'erreur standard 227 : C 5 3 228 : C Erreur anormale.contactez votre support 229 : C 229 : CALL ERREUR(5) 230 : GOTO 9999 231 : ENDIF 232 : C 233 : SEGSUP MTYPL 234 : SEGDES MLELEM 235 : SEGSUP PONBEL 236 : SEGDES MCENEL 237 : 9999 CONTINUE 238 : RETURN 239 : * 240 : * End of subroutine LE2ME2 241 : * 242 : END 243 : 244 : 245 : 246 : 247 :
© Cast3M 2003 - All rights reserved.
Disclaimer