1 : C ELENBL SOURCE CHAT 05/01/12 23:31:01 5004 2 : SUBROUTINE ELENBL(MCLAS,MCLPO1,MCENT,LEPOEL, 3 : $ ELNBEL,IMPR,IRET) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : C*********************************************************************** 7 : C NOM : ELENBL 8 : C DESCRIPTION : Construit une liste d'entiers : ELNBEL (type MLENTI) 9 : * NOCENT : indice du centre de l'élément considéré dans MCENT 10 : * ELNBEL(NOCENT) : nombre d'éléments partageant (au moins) 11 : * un point de MCLPO1 avec l'élément considéré. 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 : KRIPAD : MELEME -> (num. globale->locale) 18 : C APPELES (E/S) : - 19 : C APPELES (BLAS) : - 20 : C APPELES (CALCUL) : - 21 : C APPELE PAR : ELPOEL 22 : C*********************************************************************** 23 : C SYNTAXE GIBIANE : - 24 : C ENTREES : MCLAS (type MELEME) : maillage de classe de 25 : C points (sommet, face) par 26 : C élément (MMAIL,ELTFA) 27 : C MCLPO1 (type MELEME) : maillage de points 28 : C correspondant à MCLAS 29 : C MCENT (type MELEME) : maillage des centres de 30 : C MCLAS 31 : C LEPOEL (type MLELEM) : 32 : * NOPOI1 : indice du point considéré dans MCLPO1 33 : * LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)) : 34 : * contient le numéro du point considéré 35 : * LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)+1 36 : * -> LEPOEL.INDEX(NOPOI1+1)-1) : 37 : * contient les numéro des points centre 38 : * des éléments contenant le point considéré 39 : C 40 : C ENTREES/SORTIES : - 41 : C SORTIES : ELNBEL (type MLENTI) 42 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 43 : C*********************************************************************** 44 : C VERSION : v1, 02/11/98, version initiale 45 : C HISTORIQUE : v1, 02/11/98, création 46 : C HISTORIQUE : 47 : C HISTORIQUE : 48 : C*********************************************************************** 49 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 50 : C en cas de modification de ce sous-programme afin de faciliter 51 : C la maintenance ! 52 : C*********************************************************************** 53 : -INC CCOPTIO 54 : -INC SMELEME 55 : POINTEUR MCLAS.MELEME 56 : POINTEUR MCLPO1.MELEME 57 : POINTEUR MCENT.MELEME 58 : -INC SMLENTI 59 : POINTEUR ELNBEL.MLENTI 60 : POINTEUR KRIPO1.MLENTI 61 : POINTEUR TMPCEN.MLENTI 62 : * 63 : * Segment MLELEM 64 : * 65 : SEGMENT MLELEM 66 : INTEGER INDEX(NBL+1) 67 : INTEGER LESPOI(NBTPOI) 68 : ENDSEGMENT 69 : * 70 : * LISTE SEQUENTIELLE INDEXEE D'ELEMENTS 71 : * 72 : * NBL : NOMBRE D'ELEMENTS 73 : * NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES 74 : * INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT 75 : * DANS LE TABLEAU LESPOI 76 : * LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS 77 : * DU IEME ELEMENT 78 : * 79 : POINTEUR LEPOEL.MLELEM 80 : INTEGER IMPR,IRET 81 : LOGICAL LFOUND 82 : * 83 : * Executable statements 84 : * 85 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans elenbl.eso' 86 : SEGACT MCLPO1 87 : NBSOUS=MCLPO1.LISOUS(/1) 88 : NOTYP =MCLPO1.ITYPEL 89 : IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN 90 : WRITE(IOIMP,*) 'MCLPO1 must contain only POI1 elements' 91 : GOTO 9999 92 : ENDIF 93 : C In KRIPAD : SEGINI KRIPO1 93 : CALL KRIPAD(MCLPO1,KRIPO1) 94 : NBPOI1=MCLPO1.NUM(/2) 95 : SEGDES MCLPO1 96 : SEGACT MCENT 97 : NBSOUS=MCENT.LISOUS(/1) 98 : NOTYP =MCENT.ITYPEL 99 : IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN 100 : WRITE(IOIMP,*) 'MCENT must contain only POI1 elements' 101 : GOTO 9999 102 : ENDIF 103 : NBCENT=MCENT.NUM(/2) 104 : JG=NBCENT 105 : SEGINI ELNBEL 106 : * On a besoin du max. du nombre de centres adjacents à un point 107 : * de MCLPO1 pour avoir une estimation 108 : * du nombre max de centres adjacents à l'élément en cours 109 : SEGACT LEPOEL 110 : NBLEPO=LEPOEL.INDEX(/1)-1 111 : IF (NBLEPO.NE.NBPOI1) THEN 112 : WRITE(IOIMP,*) 113 : $ 'Dimension of MCLPO1 and LEPOEL are not compatible' 114 : GOTO 9999 115 : ENDIF 116 : MAPOCE=0 117 : DO 1 INBL=1,NBLEPO 118 : MAPOCE=MAX(MAPOCE,(LEPOEL.INDEX(INBL+1)-LEPOEL.INDEX(INBL))) 119 : 1 CONTINUE 120 : * Dans LEPOEL, on a a la fois le point et les centre adjacents 121 : MAPOCE=MAPOCE-1 122 : * Parcourons le maillage géométrique 123 : SEGACT MCLAS 124 : NBSOUS=MCLAS.LISOUS(/1) 125 : IF (NBSOUS.EQ.0) NBSOUS=1 126 : ICENT=0 127 : DO 2 INBSOU=1,NBSOUS 128 : IF (NBSOUS.GT.1) THEN 129 : IPT1=MCLAS.LISOUS(INBSOU) 130 : SEGACT IPT1 131 : ELSE 132 : IPT1=MCLAS 133 : ENDIF 134 : NBPOEL=IPT1.NUM(/1) 135 : NBELEM=IPT1.NUM(/2) 136 : JG=NBPOEL*MAPOCE 137 : * TMPCEN sert à stocker les centres adajacents à l'élément 138 : * en cours. Il faut faire attention à ne pas stocker deux 139 : * fois le meme numéro de centre. 140 : SEGINI TMPCEN 141 : DO 22 INBEL=1,NBELEM 142 : ICENT=ICENT+1 143 : ITMPC=1 144 : * On stocke le centre de l'élément considéré en premier 145 : TMPCEN.LECT(ITMPC)=MCENT.NUM(1,ICENT) 146 : DO 222 INBPO=1,NBPOEL 147 : NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL)) 148 : IF (NOPOI1.NE.0) THEN 149 : DO 2222 IPOCE=LEPOEL.INDEX(NOPOI1)+1, 150 : $ LEPOEL.INDEX(NOPOI1+1)-1 151 : NUMCEN=LEPOEL.LESPOI(IPOCE) 152 : IBTMPC=1 153 : * On cherche si le centre de numéro NUMCEN n'est pas deja 154 : * dans la liste TMPCEN 155 : 22222 CONTINUE 156 : LFOUND=(NUMCEN.EQ.TMPCEN.LECT(IBTMPC)) 157 : IF (.NOT.LFOUND.AND.(IBTMPC.LT.ITMPC)) THEN 158 : IBTMPC=IBTMPC+1 159 : GOTO 22222 160 : ENDIF 161 : * Il n'est pas dans la liste, on le rajoute 162 : IF (.NOT.LFOUND) THEN 163 : ITMPC=ITMPC+1 164 : TMPCEN.LECT(ITMPC)=NUMCEN 165 : ENDIF 166 : 2222 CONTINUE 167 : ELSE 168 : WRITE(IOIMP,*) 'Erreur grave MCLPO1 n''est pas' 169 : WRITE(IOIMP,*) 'le maillage de points correspondant' 170 : WRITE(IOIMP,*) 'à MCLAS.' 171 : ENDIF 172 : 222 CONTINUE 173 : * ITMPC-1 car TMPCEN contient aussi le centre de l'élément 174 : * courant 175 : ELNBEL.LECT(ICENT)=ITMPC-1 176 : 22 CONTINUE 177 : IF (NBSOUS.GT.1) SEGDES IPT1 178 : SEGSUP TMPCEN 179 : 2 CONTINUE 180 : SEGDES MCLAS 181 : SEGDES LEPOEL 182 : SEGDES MCENT 183 : SEGSUP KRIPO1 184 : IF (IMPR.GT.2) THEN 185 : WRITE(IOIMP,*) 'On a créé ELNBEL (type MLENTI)=',ELNBEL 186 : IF (IMPR.GT.3) THEN 187 : WRITE(IOIMP,4000) 'ELNBEL',NBCENT 188 : WRITE(IOIMP,5000) (ELNBEL.LECT(I),I=1,NBCENT) 189 : ENDIF 190 : ENDIF 191 : SEGDES ELNBEL 192 : * 193 : * Normal termination 194 : * 195 : IRET=0 196 : RETURN 197 : * 198 : * Format handling 199 : * 200 : 4000 FORMAT (A,'(1..',I8,')') 201 : 5000 FORMAT (8(1X,I8)) 202 : * 203 : * Error handling 204 : * 205 : 9999 CONTINUE 206 : IRET=1 207 : WRITE(IOIMP,*) 'An error was detected in subroutine elenbl' 208 : RETURN 209 : * 210 : * End of subroutine ELENBL 211 : * 212 : END 213 : 214 : 215 :
© Cast3M 2003 - All rights reserved.
Disclaimer