1 : C ELENB2 SOURCE CHAT 05/01/12 23:30:51 5004 2 : SUBROUTINE ELENB2(MCLAS,MCLPO1,MCENT,LEPOEL,ELNBEL) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C NOM : ELENB2 7 : C DESCRIPTION : Construit une liste d'entiers : ELNBEL (type MLENTI) 8 : * NOCENT : indice du centre de l'élément considéré dans MCENT 9 : * ELNBEL(NOCENT) : nombre d'éléments partageant (au moins) 10 : * un point de MCLPO1 avec l'élément considéré. 11 : C 12 : C LANGAGE : ESOPE 13 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) 14 : C mél : gounand@semt2.smts.cea.fr 15 : C*********************************************************************** 16 : C APPELES : 17 : C APPELES (Outils) : -KRIPAD : MELEME -> (num. globale->locale), ERREUR 18 : C APPELES (E/S) : - 19 : C APPELES (BLAS) : - 20 : C APPELES (CALCUL) : - 21 : C*********************************************************************** 22 : C SYNTAXE GIBIANE : - 23 : C ENTREES : MCLAS (type MELEME) : maillage 24 : C chaque el contient les 25 : C points sommets 26 : C 27 : C MCLPO1 (type MELEME) : maillage de POI1 (les 28 : C sommets) 29 : C 30 : C MCENT (type MELEME) : maillage des centres de 31 : C MCLAS 32 : C 33 : C LEPOEL (type MLELEM) : 34 : * NOPOI1 : indice du point considéré dans MCLPO1 35 : * LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)) : 36 : * contient le numéro du point considéré 37 : * LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)+1 38 : * -> LEPOEL.INDEX(NOPOI1+1)-1) : 39 : * contient les numéro des points centre 40 : * des éléments contenant le point considéré 41 : C 42 : C ENTREES/SORTIES : - 43 : C SORTIES : NOCENT (type MELEME) 44 : C*********************************************************************** 45 : C VERSION : v1, 02/11/98, version initiale 46 : C HISTORIQUE : v1, 02/11/98, création 47 : C HISTORIQUE : v1, 10/04/00, ajout de qqc commentaire, A. BECCANTINI 48 : C HISTORIQUE : 49 : C*********************************************************************** 50 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 51 : C en cas de modification de ce sous-programme afin de faciliter 52 : C la maintenance ! 53 : C*********************************************************************** 54 : -INC CCOPTIO 55 : -INC SMELEME 56 : POINTEUR MCLAS.MELEME 57 : POINTEUR MCLPO1.MELEME 58 : POINTEUR MCENT.MELEME 59 : -INC SMLENTI 60 : POINTEUR ELNBEL.MLENTI 61 : POINTEUR KRIPO1.MLENTI 62 : POINTEUR TMPCEN.MLENTI 63 : * 64 : * Segment MLELEM 65 : * 66 : SEGMENT MLELEM 67 : INTEGER INDEX(NBL+1) 68 : INTEGER LESPOI(NBTPOI) 69 : ENDSEGMENT 70 : * 71 : * LISTE SEQUENTIELLE INDEXEE D'ELEMENTS 72 : * 73 : * NBL : NOMBRE D'ELEMENTS 74 : * NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES 75 : * INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT 76 : * DANS LE TABLEAU LESPOI 77 : * LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS 78 : * DU IEME ELEMENT 79 : * 80 : POINTEUR LEPOEL.MLELEM 81 : C 82 : C**** Variables de COOPTIO 83 : C 84 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 85 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 86 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 87 : C & ,IECHO, IIMPI, IOSPI 88 : C & ,IDIM 89 : C & ,MCOORD 90 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 91 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 92 : C & ,NORINC,NORVAL,NORIND,NORVAD 93 : C & ,NUCROU, IPSAUV 94 : INTEGER JG, NBSOUS, NOTYP, NBPOI1, NBCENT, NBLEPO, MAPOCE, INBL 95 : & ,NBPOEL, NBELEM, ICENT, INBSOU, INBEL, ITMPC, NOPOI1 96 : & , IPOCE, NUMCEN, IBTMPC, INBPO 97 : LOGICAL LFOUND 98 : * 99 : * Executable statements 100 : * 101 : SEGACT MCLPO1 102 : NBSOUS=MCLPO1.LISOUS(/1) 103 : NOTYP =MCLPO1.ITYPEL 104 : IF ((NBSOUS.NE.0).OR.(NOTYP.NE.1)) THEN 105 : MOTERR(1:40) = 'Subroutine elenb2.eso ' 106 : WRITE(IOIMP,*) MOTERR(1:40) 107 : C 108 : C******* 'MCLPO1 must contain only POI1 elements' 109 : C Message d'erreur standard 110 : C 5 3 111 : C Erreur anormale.contactez votre support 112 : C 112 : CALL ERREUR(5) 113 : GOTO 9999 114 : ENDIF 115 : C In KRIPAD : SEGINI KRIPO1 115 : CALL KRIPAD(MCLPO1,KRIPO1) 116 : NBPOI1=MCLPO1.NUM(/2) 117 : SEGDES MCLPO1 118 : SEGACT MCENT 119 : NBSOUS=MCENT.LISOUS(/1) 120 : NOTYP =MCENT.ITYPEL 121 : IF ((NBSOUS.NE.0).OR.(NOTYP.NE.1)) THEN 122 : C 123 : C******* 'MCENT must contain only POI1 elements' 124 : C 125 : C Message d'erreur standard 126 : C 5 3 127 : C Erreur anormale.contactez votre support 128 : C 129 : MOTERR(1:40) = 'Subroutine elenb2.eso ' 130 : WRITE(IOIMP,*) MOTERR(1:40) 130 : CALL ERREUR(5) 131 : GOTO 9999 132 : ENDIF 133 : C 134 : NBCENT=MCENT.NUM(/2) 135 : JG=NBCENT 136 : SEGINI ELNBEL 137 : C 138 : C*** On a besoin du max. du nombre de centres adjacents à un point 139 : C de MCLPO1 pour avoir une estimation du nombre max de centres 140 : C adjacents à l'élément en cours 141 : C 142 : C N.B.: max(voisins d'un sommet)*(sommets dans un elt) > 143 : C nombre max de centres adjacents à l'élément 144 : C 145 : SEGACT LEPOEL 146 : NBLEPO=LEPOEL.INDEX(/1)-1 147 : IF (NBLEPO.NE.NBPOI1) THEN 148 : C 149 : C******* 'Dimension of MCLPO1 and LEPOEL are not compatible' 150 : C 151 : C Message d'erreur standard 152 : C 5 3 153 : C Erreur anormale.contactez votre support 154 : C 155 : MOTERR(1:40) = 'Subroutine elenb2.eso ' 156 : WRITE(IOIMP,*) MOTERR(1:40) 156 : CALL ERREUR(5) 157 : GOTO 9999 158 : ENDIF 159 : MAPOCE=0 160 : DO 1 INBL=1,NBLEPO 161 : MAPOCE=MAX(MAPOCE,(LEPOEL.INDEX(INBL+1)-LEPOEL.INDEX(INBL))) 162 : 1 CONTINUE 163 : C 164 : C**** Dans LEPOEL, on a a la fois le point et les centres adjacents donc 165 : C 166 : MAPOCE=MAPOCE-1 167 : C 168 : C**** Parcourons le maillage géométrique 169 : C 170 : SEGACT MCLAS 171 : NBSOUS=MCLAS.LISOUS(/1) 172 : IF (NBSOUS.EQ.0) NBSOUS=1 173 : ICENT=0 174 : DO 2 INBSOU=1,NBSOUS 175 : IF (NBSOUS.GT.1) THEN 176 : IPT1=MCLAS.LISOUS(INBSOU) 177 : SEGACT IPT1 178 : ELSE 179 : IPT1=MCLAS 180 : ENDIF 181 : NBPOEL=IPT1.NUM(/1) 182 : NBELEM=IPT1.NUM(/2) 183 : JG=NBPOEL*MAPOCE 184 : C 185 : C******* TMPCEN sert à stocker les centres adajacents à l'élément 186 : C en cours. Il faut faire attention à ne pas stocker deux 187 : C fois le meme numéro de centre. 188 : C 189 : SEGINI TMPCEN 190 : DO 22 INBEL=1,NBELEM 191 : ICENT=ICENT+1 192 : ITMPC=1 193 : C 194 : C********** On stocke le centre de l'élément considéré en premier 195 : C 196 : TMPCEN.LECT(ITMPC)=MCENT.NUM(1,ICENT) 197 : DO 222 INBPO=1,NBPOEL 198 : NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL)) 199 : IF (NOPOI1.EQ.0) THEN 200 : C 201 : C**************** 'Erreur grave MCLPO1 n''est pas' 202 : C 'le maillage de points correspondant' 203 : C 'à MCLAS.' 204 : C Message d'erreur standard 205 : C 5 3 206 : C Erreur anormale.contactez votre support 207 : C 208 : MOTERR(1:40) = 209 : $ 'Subroutine elenb2.eso ' 210 : WRITE(IOIMP,*) MOTERR(1:40) 210 : CALL ERREUR(5) 211 : GOTO 9999 212 : ELSE 213 : C 214 : C**************** Boucle sur les voisins du point sommet NOPOI1 215 : C 216 : DO 2222 IPOCE=LEPOEL.INDEX(NOPOI1)+1, 217 : $ LEPOEL.INDEX(NOPOI1+1)-1 218 : NUMCEN=LEPOEL.LESPOI(IPOCE) 219 : IBTMPC=1 220 : C 221 : C******************* On cherche si le centre de numéro NUMCEN n'est pas 222 : C deja dans la liste TMPCEN 223 : C S'il n'est pas dans la liste, on le rajoute 224 : C 225 : 22222 CONTINUE 226 : LFOUND=(NUMCEN.EQ.TMPCEN.LECT(IBTMPC)) 227 : IF (.NOT.LFOUND.AND.(IBTMPC.LT.ITMPC)) THEN 228 : IBTMPC=IBTMPC+1 229 : GOTO 22222 230 : ENDIF 231 : IF (.NOT.LFOUND) THEN 232 : ITMPC=ITMPC+1 233 : TMPCEN.LECT(ITMPC)=NUMCEN 234 : ENDIF 235 : 2222 CONTINUE 236 : ENDIF 237 : 222 CONTINUE 238 : C 239 : C********* MCENT.NUM(1,ICENT) a: 240 : C (ITMPC-1) voisins, car TMPCEN contient aussi lui meme. 241 : C On le stoke dans le segment extensible CENVOI.MLENTI 242 : C 243 : ELNBEL.LECT(ICENT)=ITMPC-1 244 : 22 CONTINUE 245 : IF (NBSOUS.GT.1) SEGDES IPT1 246 : SEGSUP TMPCEN 247 : 2 CONTINUE 248 : SEGDES ELNBEL 249 : SEGDES MCLAS 250 : SEGDES LEPOEL 251 : SEGDES MCENT 252 : SEGSUP KRIPO1 253 : * 254 : 9999 CONTINUE 255 : RETURN 256 : * 257 : * End of subroutine ELENB2 258 : * 259 : END 260 : 261 : 262 : 263 :
© Cast3M 2003 - All rights reserved.
Disclaimer