C ELENB2 SOURCE CHAT 05/01/12 23:30:51 5004 SUBROUTINE ELENB2(MCLAS,MCLPO1,MCENT,LEPOEL,ELNBEL) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : ELENB2 C DESCRIPTION : Construit une liste d'entiers : ELNBEL (type MLENTI) * NOCENT : indice du centre de l'élément considéré dans MCENT * ELNBEL(NOCENT) : nombre d'éléments partageant (au moins) * un point de MCLPO1 avec l'élément considéré. 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 C chaque el contient les C points sommets C C MCLPO1 (type MELEME) : maillage de POI1 (les C sommets) C C MCENT (type MELEME) : maillage des centres de C MCLAS C C LEPOEL (type MLELEM) : * NOPOI1 : indice du point considéré dans MCLPO1 * LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)) : * contient le numéro du point considéré * LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)+1 * -> LEPOEL.INDEX(NOPOI1+1)-1) : * contient les numéro des points centre * des éléments contenant le point considéré C C ENTREES/SORTIES : - C SORTIES : NOCENT (type MELEME) 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 POINTEUR TMPCEN.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 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 INTEGER JG, NBSOUS, NOTYP, NBPOI1, NBCENT, NBLEPO, MAPOCE, INBL & ,NBPOEL, NBELEM, ICENT, INBSOU, INBEL, ITMPC, NOPOI1 & , IPOCE, NUMCEN, IBTMPC, INBPO 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 elenb2.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) NBPOI1=MCLPO1.NUM(/2) SEGDES MCLPO1 SEGACT MCENT NBSOUS=MCENT.LISOUS(/1) NOTYP =MCENT.ITYPEL IF ((NBSOUS.NE.0).OR.(NOTYP.NE.1)) THEN C C******* 'MCENT must contain only POI1 elements' C C Message d'erreur standard C 5 3 C Erreur anormale.contactez votre support C MOTERR(1:40) = 'Subroutine elenb2.eso ' WRITE(IOIMP,*) MOTERR(1:40) CALL ERREUR(5) GOTO 9999 ENDIF C NBCENT=MCENT.NUM(/2) JG=NBCENT SEGINI ELNBEL C C*** On a besoin du max. du nombre de centres adjacents à un point C de MCLPO1 pour avoir une estimation du nombre max de centres C adjacents à l'élément en cours C C N.B.: max(voisins d'un sommet)*(sommets dans un elt) > C nombre max de centres adjacents à l'élément C SEGACT LEPOEL NBLEPO=LEPOEL.INDEX(/1)-1 IF (NBLEPO.NE.NBPOI1) THEN C C******* 'Dimension of MCLPO1 and LEPOEL are not compatible' C C Message d'erreur standard C 5 3 C Erreur anormale.contactez votre support C MOTERR(1:40) = 'Subroutine elenb2.eso ' WRITE(IOIMP,*) MOTERR(1:40) CALL ERREUR(5) GOTO 9999 ENDIF MAPOCE=0 DO 1 INBL=1,NBLEPO MAPOCE=MAX(MAPOCE,(LEPOEL.INDEX(INBL+1)-LEPOEL.INDEX(INBL))) 1 CONTINUE C C**** Dans LEPOEL, on a a la fois le point et les centres adjacents donc C MAPOCE=MAPOCE-1 C C**** Parcourons le maillage géométrique C SEGACT MCLAS NBSOUS=MCLAS.LISOUS(/1) IF (NBSOUS.EQ.0) NBSOUS=1 ICENT=0 DO 2 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) JG=NBPOEL*MAPOCE C C******* TMPCEN sert à stocker les centres adajacents à l'élément C en cours. Il faut faire attention à ne pas stocker deux C fois le meme numéro de centre. C SEGINI TMPCEN DO 22 INBEL=1,NBELEM ICENT=ICENT+1 ITMPC=1 C C********** On stocke le centre de l'élément considéré en premier C TMPCEN.LECT(ITMPC)=MCENT.NUM(1,ICENT) DO 222 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 elenb2.eso ' WRITE(IOIMP,*) MOTERR(1:40) CALL ERREUR(5) GOTO 9999 ELSE C C**************** Boucle sur les voisins du point sommet NOPOI1 C DO 2222 IPOCE=LEPOEL.INDEX(NOPOI1)+1, $ LEPOEL.INDEX(NOPOI1+1)-1 NUMCEN=LEPOEL.LESPOI(IPOCE) IBTMPC=1 C C******************* On cherche si le centre de numéro NUMCEN n'est pas C deja dans la liste TMPCEN C S'il n'est pas dans la liste, on le rajoute C 22222 CONTINUE LFOUND=(NUMCEN.EQ.TMPCEN.LECT(IBTMPC)) IF (.NOT.LFOUND.AND.(IBTMPC.LT.ITMPC)) THEN IBTMPC=IBTMPC+1 GOTO 22222 ENDIF IF (.NOT.LFOUND) THEN ITMPC=ITMPC+1 TMPCEN.LECT(ITMPC)=NUMCEN ENDIF 2222 CONTINUE ENDIF 222 CONTINUE C C********* MCENT.NUM(1,ICENT) a: C (ITMPC-1) voisins, car TMPCEN contient aussi lui meme. C On le stoke dans le segment extensible CENVOI.MLENTI C ELNBEL.LECT(ICENT)=ITMPC-1 22 CONTINUE IF (NBSOUS.GT.1) SEGDES IPT1 SEGSUP TMPCEN 2 CONTINUE SEGDES ELNBEL SEGDES MCLAS SEGDES LEPOEL SEGDES MCENT SEGSUP KRIPO1 * 9999 CONTINUE RETURN * * End of subroutine ELENB2 * END