C ELELE2 SOURCE CHAT 05/01/12 23:30:28 5004 SUBROUTINE ELELE2(MCLAS,MCLPO1,MCENT,LEPOEL,ELNBEL,LEELEL) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : ELELE2 C DESCRIPTION : On construit la liste séquentielle indexée d'éléments C LEELEL (type MLELEM). * NOCENT : indice du centre de l'élément considéré dans * MCENT * LEELEL.LESPOI(LEELEL.INDEX(NOCENT)) : * contient le numéro du centre de l'élément considéré * LEELEL.LESPOI(LEPOEL.INDEX(NOCENT)+1 * -> LEPOEL.INDEX(NOCENT+1)-1) : * contient les numéro des points centre des éléments * qui ont un point de MCLPO1 en commun avec l'élément * considéré (!) * * ELNBEL est tel que ELNBEL(NOCENT) = nb d'éléments ayant au * moins un point de MCLPO1 * en commun avec l'élément * dont l'indice du centre * dans MCENT est NOCENT. * ELNBEL est calculé dans la subroutine elenb2.eso * Il sert à dimensionner le tableau LESPOI et remplir * le tableau INDEX du segment LEELEL. 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) : - KRIPAD : MELEME -> (num. globale->locale), ERREUR C APPELES (E/S) : - C APPELES (BLAS) : - C APPELES (CALCUL) : - C*********************************************************************** C SYNTAXE GIBIANE : - C ENTREES : MCLAS (type MELEME) : maillage de classe de C points (sommet, face) par C élément (MMAIL,ELTFA) C MCLPO1 (type MELEME) : maillage de points C correspondant à MCLAS C MCENT (type MELEME) : un maillage de C points (dits 'centres') ayant le meme C nombre d'éléments que MCLAS et C servant à repérer les éléments de MCLAS. C ELNBEL (type MLENTI) : voir DESCRIPTION C C ENTREES/SORTIES : - C SORTIES : LEELEL (type MLELEM) : liste séquentielle indexée C d'éléments (cf. plus haut) C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 02/11/98, version initiale C HISTORIQUE : v1, 02/11/98, création C HISTORIQUE : v1, 10/04/00, ajout de qqc commentaire, A. BECCANTINI 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 POINTEUR MCLAS.MELEME POINTEUR MCLPO1.MELEME POINTEUR MCENT.MELEME -INC SMLENTI POINTEUR ELNBEL.MLENTI POINTEUR KRIPO1.MLENTI * * 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 * POINTEUR LEPOEL.MLELEM POINTEUR LEELEL.MLELEM 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 NBSOUS,NOTYP,NBCENT,NELNB,NBL,NBTPOI,IDEPA & ,ICENT,INBSOU,NBELEM,NBPOEL,INBEL,INBPO,NOPOI1,NUMCEN & ,IBCOUR,ICOUR,INBL,IPOEL LOGICAL LFOUND * * Executable statements * SEGACT MCLPO1 NBSOUS=MCLPO1.LISOUS(/1) NOTYP =MCLPO1.ITYPEL IF ((NBSOUS.NE.0).OR.(NOTYP.NE.1)) THEN MOTERR(1:40) = 'Subroutine elele2.eso ' WRITE(IOIMP,*) MOTERR(1:40) C C******* 'MCLPO1 must contain only POI1 elements' C Message d'erreur standard C 5 3 C Erreur anormale.contactez votre support C CALL ERREUR(5) GOTO 9999 ENDIF C In KRIPAD : SEGINI KRIPO1 CALL KRIPAD(MCLPO1,KRIPO1) SEGDES MCLPO1 SEGACT MCENT NBSOUS=MCENT.LISOUS(/1) NOTYP =MCENT.ITYPEL IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN MOTERR(1:40) = 'Subroutine elele2.eso ' WRITE(IOIMP,*) MOTERR(1:40) C C******* 'MCLPO1 must contain only POI1 elements' C Message d'erreur standard C 5 3 C Erreur anormale.contactez votre support C CALL ERREUR(5) GOTO 9999 ENDIF NBCENT=MCENT.NUM(/2) SEGACT ELNBEL NELNB=ELNBEL.LECT(/1) IF (NELNB.NE.NBCENT) THEN MOTERR(1:40) = 'Subroutine elele2.eso ' WRITE(IOIMP,*) MOTERR(1:40) C C******* 'Dimension of MCENT and ELNBEL are not equal' C Message d'erreur standard C 5 3 C Erreur anormale.contactez votre support C CALL ERREUR(5) GOTO 9999 ENDIF C C On initialise le segment LEELEL (type MLELEM) C NBL=NBCENT NBTPOI=0 SEGINI LEELEL IDEPA=1 DO 1 INBL=1,NBL LEELEL.INDEX(INBL)=IDEPA IDEPA=IDEPA+1+ELNBEL.LECT(INBL) 1 CONTINUE LEELEL.INDEX(NBL+1)=IDEPA SEGDES ELNBEL NBTPOI=IDEPA-1 SEGADJ LEELEL SEGACT LEPOEL * * Parcourons le maillage * SEGACT MCLAS NBSOUS=MCLAS.LISOUS(/1) IF (NBSOUS.EQ.0) NBSOUS=1 ICENT=0 DO 3 INBSOU=1,NBSOUS IF (NBSOUS.GT.1) THEN IPT1=MCLAS.LISOUS(INBSOU) SEGACT IPT1 ELSE IPT1=MCLAS ENDIF NBPOEL=IPT1.NUM(/1) NBELEM=IPT1.NUM(/2) DO 32 INBEL=1,NBELEM ICENT=ICENT+1 LEELEL.LESPOI(LEELEL.INDEX(ICENT))=MCENT.NUM(1,ICENT) ICOUR=LEELEL.INDEX(ICENT)+1 DO 322 INBPO=1,NBPOEL NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL)) IF (NOPOI1.EQ.0) THEN C C**************** 'Erreur grave MCLPO1 n''est pas' C 'le maillage de points correspondant' C 'à MCLAS.' C Message d'erreur standard C 5 3 C Erreur anormale.contactez votre support C MOTERR(1:40) = $ 'Subroutine elele2.eso ' WRITE(IOIMP,*) MOTERR(1:40) CALL ERREUR(5) GOTO 9999 ELSE DO 3222 IPOEL=LEPOEL.INDEX(NOPOI1)+1, $ LEPOEL.INDEX(NOPOI1+1)-1 NUMCEN=LEPOEL.LESPOI(IPOEL) C C******************* Mise a jour de IBCOUR C IBCOUR=LEELEL.INDEX(ICENT) 32222 CONTINUE LFOUND=(NUMCEN.EQ.LEELEL.LESPOI(IBCOUR)) IF (.NOT.LFOUND.AND.(IBCOUR.LT.ICOUR)) THEN IBCOUR=IBCOUR+1 GOTO 32222 ENDIF IF (.NOT.LFOUND) THEN LEELEL.LESPOI(ICOUR)=NUMCEN ICOUR=ICOUR+1 ENDIF 3222 CONTINUE ENDIF 322 CONTINUE 32 CONTINUE IF (NBSOUS.GT.1) SEGDES IPT1 3 CONTINUE SEGDES MCLAS SEGDES LEPOEL SEGDES LEELEL SEGDES MCENT SEGSUP KRIPO1 * 9999 CONTINUE RETURN * * End of subroutine ELELE2 * END