C POELE2 SOURCE CHAT 05/01/13 02:16:18 5004 SUBROUTINE POELE2(MCLAS,MCONT,MCLPO1,MCENT,MCCEN,PONBEL,LEPOEL) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : POELE2 C DESCRIPTION : On construit la liste séquentielle indexée C d'éléments 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éros des points centre des * éléments de MCLAS et MCONT contenant le point * considéré (!) * i.e. il est composé de subvecteurs * * LEPOEL.LESPOI(I)=(I-eme point, ses elts "voisins") * * PONBEL est tel que PONBEL(NOPOI1) = nb d'éléments * contenant le POI1 ou NOPOI1 est le numéro local du point * dans MCLPO1 * * PONBEL est calculé dans la subroutine ponbel.eso * Il sert à dimensionner le tableau LESPOI et remplir * le tableau INDEX du segment LEPOEL. 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 C MCONT (type MELEME) : maillage de classe de C points (face) par éléments C du contour de MCLAS C C MCLPO1 (type MELEME) : maillage de points C correspondant à MCLAS C 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 C MCCEN (type MELEME) : un maillage de C points (dits 'centres') ayant le meme C nombre d'éléments que MCONT et C servant à repérer les éléments de MCONT. C C PONBEL (type MLENTI) : une liste indiquant C à combien d'éléments de MCLAS et MCONT C appartient un point de MCLPO1. C C ENTREES/SORTIES : - C SORTIES : LEPOEL (type MLELEM) : liste séquentielle indexée C d'éléments (cf. plus haut) C C*********************************************************************** C VERSION : v1, 02/11/98, version initiale C HISTORIQUE : v1, 02/11/98, création C HISTORIQUE : 07.04.2000, ajout de commentaires, 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 MCONT.MELEME POINTEUR MCLPO1.MELEME POINTEUR MCENT.MELEME POINTEUR MCCEN.MELEME -INC SMLENTI POINTEUR PONBEL.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 ICOUR.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, NBPOI1, NPONB, NBL, NBTPOI & , IDEPA, INBL, INBSOU, NBPOEL, NBELEM, INBEL & , INBPO, ICENT, NOPOI1, NBPOM1, NOCEN, NOCEN1 * * Executable statements * SEGACT MCLPO1 NBSOUS=MCLPO1.LISOUS(/1) NOTYP =MCLPO1.ITYPEL IF ((NBSOUS.NE.0) .OR. (NOTYP.NE.1)) THEN MOTERR(1:40) = 'Subroutine poele2.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 NBPOI1=MCLPO1.NUM(/2) SEGACT PONBEL NPONB=PONBEL.LECT(/1) IF (NPONB.NE.NBPOI1) THEN MOTERR(1:40) = 'Subroutine poele2.eso ' WRITE(IOIMP,*) MOTERR(1:40) C C******* 'Dimension of MCLPO1 and PONBEL 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 LEPOEL (type MLELEM) C et le segment ICOUR (type MLELEM) C dans ICOUR, seul le tableau INDEX nous intéresse C NBL=NBPOI1 NBTPOI=0 SEGINI LEPOEL IDEPA=1 DO 2 INBL=1,NBL LEPOEL.INDEX(INBL)=IDEPA IDEPA=IDEPA+1+PONBEL.LECT(INBL) 2 CONTINUE C C**** LEPOEL.LESPOI: C ith-subarray (MCLPO1.NUM(1,I), 1-st neigh., ... ,last neigh.) C in the array ^ ^ C | | C position= LEPOEL.INDEX(i) position LEPOEL.INDEX(i)-1 C C In LEPOEL.INDEX(NBPOI1+1) we have: C (position of the last neighbour of MCLPO1.NUM(1,NBPOI1)) + 1 C C NBL = NBPOI1 C LEPOEL.INDEX(NBL+1)=IDEPA SEGDES PONBEL SEGINI,ICOUR=LEPOEL NBTPOI=IDEPA-1 SEGADJ LEPOEL C C On remplit LESPOI(INDEX(I)) avec le numéro du Ieme point C de MCLPO1. C DO 3 INBL=1,NBL LEPOEL.LESPOI(ICOUR.INDEX(INBL))=MCLPO1.NUM(1,INBL) ICOUR.INDEX(INBL)=ICOUR.INDEX(INBL)+1 3 CONTINUE C C**** ICOUR.INDEX(INBL) = position of the first neigh. of the INBL C point de MCLPO1, i.e. la position a remplir quand on va C inserer les centres des elts voisins de INBL C C ICOUR.LESPOI est vide (dimension = 0)! C C C In KRIPAD : SEGINI KRIPO1 C CALL KRIPAD(MCLPO1,KRIPO1) SEGDES MCLPO1 C C On remplit LESPOI(INDEX(I)+1 -> INDEX(I+1)-1) C avec les points centres des éléments contenant le C Ieme point de MCLPO1. C C On procède en bouclant sur les éléments de MCLAS pour C remplir le tableau LESPOI. C SEGACT MCENT SEGACT MCLAS NBSOUS=MCLAS.LISOUS(/1) IF (NBSOUS.EQ.0) NBSOUS=1 ICENT=0 DO 4 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 42 INBEL=1,NBELEM C C********** Boucle sur les elts C ICENT=ICENT+1 NOCEN=MCENT.NUM(1,ICENT) DO 422 INBPO=1,NBPOEL C C************* Boucle sur les noeuds des elts C NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL)) IF (NOPOI1.NE.0) THEN LEPOEL.LESPOI(ICOUR.INDEX(NOPOI1))=NOCEN ICOUR.INDEX(NOPOI1)=ICOUR.INDEX(NOPOI1)+1 ELSE 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 poele2.eso ' WRITE(IOIMP,*) MOTERR(1:40) CALL ERREUR(5) GOTO 9999 ENDIF 422 CONTINUE 42 CONTINUE IF (NBSOUS.GT.1) SEGDES IPT1 4 CONTINUE SEGDES MCLAS SEGDES MCENT C C On procède en bouclant sur les éléments de MCONT pour C remplir le tableau LESPOI. C SEGACT MCCEN SEGACT MCONT NBSOUS=MCONT.LISOUS(/1) IF (NBSOUS.EQ.0) NBSOUS=1 ICENT=0 DO 5 INBSOU=1,NBSOUS IF (NBSOUS.GT.1) THEN IPT1=MCONT.LISOUS(INBSOU) SEGACT IPT1 ELSE IPT1=MCONT ENDIF NBPOEL=IPT1.NUM(/1) NBPOM1=NBPOEL - 1 C C******* NOPOI1=KRIPO1.LECT(IPT1.NUM(NBPOEL,INBEL)) = CENTRE DE FACE C NBELEM=IPT1.NUM(/2) DO 52 INBEL=1,NBELEM ICENT=ICENT+1 NOCEN=MCCEN.NUM(1,ICENT) NOCEN1 = IPT1.NUM(NBPOEL,INBEL) IF(NOCEN .NE. NOCEN1)THEN MOTERR(1:40) = 'Subroutine poele2.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) ENDIF DO 522 INBPO=1,NBPOM1 NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL)) IF (NOPOI1.NE.0) THEN LEPOEL.LESPOI(ICOUR.INDEX(NOPOI1))=NOCEN ICOUR.INDEX(NOPOI1)=ICOUR.INDEX(NOPOI1)+1 ENDIF 522 CONTINUE 52 CONTINUE IF (NBSOUS.GT.1) SEGDES IPT1 5 CONTINUE SEGDES MCONT SEGDES MCCEN C C**** Si tu as bien marche', ICOUR.INDEX(I) = LEPOEL.INDEX(I+1) C DO 6 INBL = 1, NBL IF(ICOUR.INDEX(INBL) .NE. LEPOEL.INDEX(INBL+1))THEN MOTERR(1:40) = 'Subroutine poele2.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) ENDIF 6 CONTINUE C C C**** Test C C WRITE(*,*) 'LEPOEL.INDEX',NBL+1 C WRITE(*,*) (LEPOEL.INDEX(I),I=1,NBL+1) C WRITE(*,*) 'LEPOEL.LESPOI',NBTPOI C WRITE(*,*) (LEPOEL.LESPOI(I),I=1,NBTPOI) C SEGDES LEPOEL SEGSUP ICOUR SEGSUP KRIPO1 9999 CONTINUE RETURN * * End of subroutine POELE2 * END