C LE2ME2 SOURCE CHAT 05/01/13 01:14:16 5004 SUBROUTINE LE2ME2(MLELEM,MELEME,MCENEL) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : LE2ME2 C DESCRIPTION : Construit un MELEME d'éléments POLY à C partir d'une liste séquentielle indexée d'éléments C voir le segment MLELEM C En gros, on regroupe les éléments qui ont le meme C nombre de points. C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : - C APPELES (Outils) : - ERREUR C APPELES (BLAS) : - C APPELES (CALCUL) : - C*********************************************************************** C SYNTAXE GIBIANE : - C ENTREES : MLELEM (type MLELEM) : liste séquentielle C indexée d'éléments C ENTREES/SORTIES : - C SORTIES : MELEME ( " MELEME) : maillage de POLY C associé aux entrées. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 08/10/98, version initiale C HISTORIQUE : v1, 08/10/98, création C HISTORIQUE : 11.04.2000 Petit modif et ajout de qqc commentaire (A.B.) C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC CCOPTIO -INC SMELEME -INC SMLENTI POINTEUR PONBEL.MLENTI POINTEUR MTYPL.MLENTI POINTEUR MCENEL.MELEME * * Segment MLELEM * SEGMENT MLELEM INTEGER INDEX(NBL+1) INTEGER LESPOI(NBTPOI) ENDSEGMENT * * LISTE SEQUENTIELLE INDEXEE D'ELEMENTS * * NBL : NOMBRE D'ELEMENTS * NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES * INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT * DANS LE TABLEAU LESPOI * LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS * DU IEME ELEMENT * C C**** Variables de COOPTIO C C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES C & ,IECHO, IIMPI, IOSPI C & ,IDIM C & ,MCOORD C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU C & ,NORINC,NORVAL,NORIND,NORVAD C & ,NUCROU, IPSAUV C INTEGER JG,NBL,MAXPOI,INBL,NONOEU,NBSOUS,NBNN & ,NBELEM,NBREF,INBEL,NBNOEU,INBSO,IELEM & ,IDELEM,ITEST,IMAXPO,INBNN,NTYPL * * Executable statements * SEGACT MLELEM NBL=MLELEM.INDEX(/1)-1 * * On construit le tableau temporaire PONBEL tel que : * PONBEL(I) : NOMBRE DE POINTS DU IEME ELEMENT DE MLELEM * * On calcule aussi le maximum du nombre de points des éléments de * MLELEM. * JG=NBL SEGINI PONBEL MAXPOI=0 DO 1 INBL=1,NBL PONBEL.LECT(INBL)=MLELEM.INDEX(INBL+1)-MLELEM.INDEX(INBL) MAXPOI=MAX(MAXPOI,PONBEL.LECT(INBL)) 1 CONTINUE * * Maintenant on détermine le nombre de sous-objets (LISOUS) * que devra comporter MELEME, cad le nombre de type d'éléments * différents (distingués par le nombre de noeuds) * MTYPL(NONOEU) contient le nombre d'éléments de MLELEM ayant * NONOEU noeuds (éventuellement nul). * NTYPL contient le nombre de type d'éléments différents * à créer. * JG=MAXPOI SEGINI MTYPL DO 2 INBL=1,NBL NONOEU=PONBEL.LECT(INBL) MTYPL.LECT(NONOEU)=MTYPL.LECT(NONOEU)+1 2 CONTINUE NTYPL=0 DO 3 IMAXPO=1,MAXPOI IF (MTYPL.LECT(IMAXPO).NE.0) NTYPL=NTYPL+1 3 CONTINUE C C********** ITEST: variable de test; a la fin ITEST = nombre total de C centre NBL C ITEST = 0 * * On construit le maillage de centre du MELEME centre-voisins * NBSOUS = 0 NBNN = 1 NBELEM = NBL NBREF = 0 SEGINI MCENEL * Type d'élément : POI1 (cf. bdata.eso) MCENEL.ITYPEL = 1 * * On construit le MELEME en distinguant le cas NTYPL=1... * IF (NTYPL.EQ.1) THEN NBSOUS=0 NBNN=MAXPOI NBELEM=NBL NBREF=0 SEGINI MELEME * Type d'élément : POLY (cf. bdata.eso) MELEME.ITYPEL=32 DO 5 INBEL=1,NBL ITEST = ITEST + 1 IDELEM=MLELEM.INDEX(INBEL) C C********** IDELEM = position du centre INBEL C IDELEM+1,...,MAXPOI: position de ses voisins C DO 52 INBNN=1,MAXPOI-1 MELEME.NUM(INBNN,INBEL)=MLELEM.LESPOI(IDELEM+INBNN) 52 CONTINUE C C********** On met le centre INBEL au dernier C MELEME.NUM(MAXPOI,INBEL)=MLELEM.LESPOI(IDELEM) MCENEL.NUM(1,ITEST)=MLELEM.LESPOI(IDELEM) 5 CONTINUE SEGDES MELEME ELSE NBSOUS=NTYPL NBNN=0 NBELEM=0 NBREF=0 SEGINI MELEME NBNOEU=0 DO 7 INBSO=1,NTYPL * On cherche le nombre de noeuds du type d'éléments suivant NBNOEU=NBNOEU+1 72 CONTINUE IF (MTYPL.LECT(NBNOEU).EQ.0) THEN NBNOEU=NBNOEU+1 GOTO 72 ENDIF NBSOUS=0 * On stockera le centre en dernier NBNN=NBNOEU NBELEM=MTYPL.LECT(NBNOEU) NBREF=0 SEGINI IPT1 IPT1.ITYPEL=32 IELEM=0 DO 74 INBEL=1,NBELEM ITEST=ITEST+1 C C************* Test: on change de couleur a quelque elts pour le C visualizer C C IF(ITEST .EQ. 1) IPT1.ICOLOR(INBEL) = 2 C C************* FIN TEST C IELEM=IELEM+1 742 CONTINUE IF (PONBEL.LECT(IELEM).NE.NBNOEU) THEN C C**************** L'elt considerée n'a pas NBNOEU points C donc on passe au suivant C IELEM=IELEM+1 GOTO 742 ENDIF IDELEM = MLELEM.INDEX(IELEM) C C************* IDELEM = position du centre IELEM C IDELEM+1,...,IDELEM+NBNN: position de ses voisins C DO 744 INBNN=1,NBNN-1 IPT1.NUM(INBNN,INBEL)=MLELEM.LESPOI(IDELEM+INBNN) 744 CONTINUE C C************* On stockera le centre en dernier C IPT1.NUM(NBNN,INBEL)=MLELEM.LESPOI(IDELEM) MCENEL.NUM(1,ITEST)=MLELEM.LESPOI(IDELEM) 74 CONTINUE SEGDES IPT1 MELEME.LISOUS(INBSO)=IPT1 7 CONTINUE SEGDES MELEME ENDIF IF(ITEST .NE. NBL)THEN MOTERR(1:40) = 'Subroutine le2me2.eso ' WRITE(IOIMP,*) MOTERR(1:40) C C******* Message d'erreur standard C 5 3 C Erreur anormale.contactez votre support C CALL ERREUR(5) GOTO 9999 ENDIF C SEGSUP MTYPL SEGDES MLELEM SEGSUP PONBEL SEGDES MCENEL 9999 CONTINUE RETURN * * End of subroutine LE2ME2 * END