1 : C POELE2 SOURCE CHAT 05/01/13 02:16:18 5004 2 : SUBROUTINE POELE2(MCLAS,MCONT,MCLPO1,MCENT,MCCEN,PONBEL,LEPOEL) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C NOM : POELE2 7 : C DESCRIPTION : On construit la liste séquentielle indexée 8 : C d'éléments LEPOEL (type MLELEM). 9 : * NOPOI1 : indice du point considéré dans MCLPO1 10 : * LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)) : 11 : * contient le numéro du point considéré 12 : * LEPOEL.LESPOI(LEPOEL.INDEX(NOPOI1)+1 13 : * -> LEPOEL.INDEX(NOPOI1+1)-1) : 14 : * contient les numéros des points centre des 15 : * éléments de MCLAS et MCONT contenant le point 16 : * considéré (!) 17 : * i.e. il est composé de subvecteurs 18 : * 19 : * LEPOEL.LESPOI(I)=(I-eme point, ses elts "voisins") 20 : * 21 : * PONBEL est tel que PONBEL(NOPOI1) = nb d'éléments 22 : * contenant le POI1 ou NOPOI1 est le numéro local du point 23 : * dans MCLPO1 24 : * 25 : * PONBEL est calculé dans la subroutine ponbel.eso 26 : * Il sert à dimensionner le tableau LESPOI et remplir 27 : * le tableau INDEX du segment LEPOEL. 28 : C 29 : C LANGAGE : ESOPE 30 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) 31 : C mél : gounand@semt2.smts.cea.fr 32 : C*********************************************************************** 33 : C APPELES : 34 : C APPELES (Outils) : -KRIPAD : MELEME -> (num. globale->locale), ERREUR 35 : C APPELES (E/S) : - 36 : C APPELES (BLAS) : - 37 : C APPELES (CALCUL) : - 38 : C*********************************************************************** 39 : C SYNTAXE GIBIANE : - 40 : C ENTREES : MCLAS (type MELEME) : maillage de classe de 41 : C points (sommet, face) par 42 : C élément (MMAIL,ELTFA) 43 : C 44 : C MCONT (type MELEME) : maillage de classe de 45 : C points (face) par éléments 46 : C du contour de MCLAS 47 : C 48 : C MCLPO1 (type MELEME) : maillage de points 49 : C correspondant à MCLAS 50 : C 51 : C MCENT (type MELEME) : un maillage de 52 : C points (dits 'centres') ayant le meme 53 : C nombre d'éléments que MCLAS et 54 : C servant à repérer les éléments de MCLAS. 55 : C 56 : C MCCEN (type MELEME) : un maillage de 57 : C points (dits 'centres') ayant le meme 58 : C nombre d'éléments que MCONT et 59 : C servant à repérer les éléments de MCONT. 60 : C 61 : C PONBEL (type MLENTI) : une liste indiquant 62 : C à combien d'éléments de MCLAS et MCONT 63 : C appartient un point de MCLPO1. 64 : C 65 : C ENTREES/SORTIES : - 66 : C SORTIES : LEPOEL (type MLELEM) : liste séquentielle indexée 67 : C d'éléments (cf. plus haut) 68 : C 69 : C*********************************************************************** 70 : C VERSION : v1, 02/11/98, version initiale 71 : C HISTORIQUE : v1, 02/11/98, création 72 : C HISTORIQUE : 07.04.2000, ajout de commentaires, A. BECCANTINI 73 : C HISTORIQUE : 74 : C*********************************************************************** 75 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 76 : C en cas de modification de ce sous-programme afin de faciliter 77 : C la maintenance ! 78 : C*********************************************************************** 79 : -INC CCOPTIO 80 : -INC SMELEME 81 : POINTEUR MCLAS.MELEME 82 : POINTEUR MCONT.MELEME 83 : POINTEUR MCLPO1.MELEME 84 : POINTEUR MCENT.MELEME 85 : POINTEUR MCCEN.MELEME 86 : -INC SMLENTI 87 : POINTEUR PONBEL.MLENTI 88 : POINTEUR KRIPO1.MLENTI 89 : * 90 : * Segment MLELEM 91 : * 92 : SEGMENT MLELEM 93 : INTEGER INDEX(NBL+1) 94 : INTEGER LESPOI(NBTPOI) 95 : ENDSEGMENT 96 : * 97 : * LISTE SEQUENTIELLE INDEXEE D'ELEMENTS 98 : * 99 : * NBL : NOMBRE D'ELEMENTS 100 : * NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES 101 : * INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT 102 : * DANS LE TABLEAU LESPOI 103 : * LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS 104 : * DU IEME ELEMENT 105 : * 106 : POINTEUR LEPOEL.MLELEM 107 : POINTEUR ICOUR.MLELEM 108 : C 109 : C**** Variables de COOPTIO 110 : C 111 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 112 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 113 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 114 : C & ,IECHO, IIMPI, IOSPI 115 : C & ,IDIM 116 : C & ,MCOORD 117 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 118 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 119 : C & ,NORINC,NORVAL,NORIND,NORVAD 120 : C & ,NUCROU, IPSAUV 121 : C 122 : INTEGER NBSOUS, NOTYP, NBPOI1, NPONB, NBL, NBTPOI 123 : & , IDEPA, INBL, INBSOU, NBPOEL, NBELEM, INBEL 124 : & , INBPO, ICENT, NOPOI1, NBPOM1, NOCEN, NOCEN1 125 : * 126 : * Executable statements 127 : * 128 : SEGACT MCLPO1 129 : NBSOUS=MCLPO1.LISOUS(/1) 130 : NOTYP =MCLPO1.ITYPEL 131 : IF ((NBSOUS.NE.0) .OR. (NOTYP.NE.1)) THEN 132 : MOTERR(1:40) = 'Subroutine poele2.eso ' 133 : WRITE(IOIMP,*) MOTERR(1:40) 134 : C 135 : C******* 'MCLPO1 must contain only POI1 elements' 136 : C Message d'erreur standard 137 : C 5 3 138 : C Erreur anormale.contactez votre support 139 : C 139 : CALL ERREUR(5) 140 : GOTO 9999 141 : ENDIF 142 : NBPOI1=MCLPO1.NUM(/2) 143 : SEGACT PONBEL 144 : NPONB=PONBEL.LECT(/1) 145 : IF (NPONB.NE.NBPOI1) THEN 146 : MOTERR(1:40) = 'Subroutine poele2.eso ' 147 : WRITE(IOIMP,*) MOTERR(1:40) 148 : C 149 : C******* 'Dimension of MCLPO1 and PONBEL are not equal' 150 : C Message d'erreur standard 151 : C 5 3 152 : C Erreur anormale.contactez votre support 153 : C 153 : CALL ERREUR(5) 154 : GOTO 9999 155 : ENDIF 156 : C 157 : C On initialise le segment LEPOEL (type MLELEM) 158 : C et le segment ICOUR (type MLELEM) 159 : C dans ICOUR, seul le tableau INDEX nous intéresse 160 : C 161 : NBL=NBPOI1 162 : NBTPOI=0 163 : SEGINI LEPOEL 164 : IDEPA=1 165 : DO 2 INBL=1,NBL 166 : LEPOEL.INDEX(INBL)=IDEPA 167 : IDEPA=IDEPA+1+PONBEL.LECT(INBL) 168 : 2 CONTINUE 169 : C 170 : C**** LEPOEL.LESPOI: 171 : C ith-subarray (MCLPO1.NUM(1,I), 1-st neigh., ... ,last neigh.) 172 : C in the array ^ ^ 173 : C | | 174 : C position= LEPOEL.INDEX(i) position LEPOEL.INDEX(i)-1 175 : C 176 : C In LEPOEL.INDEX(NBPOI1+1) we have: 177 : C (position of the last neighbour of MCLPO1.NUM(1,NBPOI1)) + 1 178 : C 179 : C NBL = NBPOI1 180 : C 181 : LEPOEL.INDEX(NBL+1)=IDEPA 182 : SEGDES PONBEL 183 : SEGINI,ICOUR=LEPOEL 184 : NBTPOI=IDEPA-1 185 : SEGADJ LEPOEL 186 : C 187 : C On remplit LESPOI(INDEX(I)) avec le numéro du Ieme point 188 : C de MCLPO1. 189 : C 190 : DO 3 INBL=1,NBL 191 : LEPOEL.LESPOI(ICOUR.INDEX(INBL))=MCLPO1.NUM(1,INBL) 192 : ICOUR.INDEX(INBL)=ICOUR.INDEX(INBL)+1 193 : 3 CONTINUE 194 : C 195 : C**** ICOUR.INDEX(INBL) = position of the first neigh. of the INBL 196 : C point de MCLPO1, i.e. la position a remplir quand on va 197 : C inserer les centres des elts voisins de INBL 198 : C 199 : C ICOUR.LESPOI est vide (dimension = 0)! 200 : C 201 : C 202 : C In KRIPAD : SEGINI KRIPO1 203 : C 203 : CALL KRIPAD(MCLPO1,KRIPO1) 204 : SEGDES MCLPO1 205 : C 206 : C On remplit LESPOI(INDEX(I)+1 -> INDEX(I+1)-1) 207 : C avec les points centres des éléments contenant le 208 : C Ieme point de MCLPO1. 209 : C 210 : C On procède en bouclant sur les éléments de MCLAS pour 211 : C remplir le tableau LESPOI. 212 : C 213 : SEGACT MCENT 214 : SEGACT MCLAS 215 : NBSOUS=MCLAS.LISOUS(/1) 216 : IF (NBSOUS.EQ.0) NBSOUS=1 217 : ICENT=0 218 : DO 4 INBSOU=1,NBSOUS 219 : IF (NBSOUS.GT.1) THEN 220 : IPT1=MCLAS.LISOUS(INBSOU) 221 : SEGACT IPT1 222 : ELSE 223 : IPT1=MCLAS 224 : ENDIF 225 : NBPOEL=IPT1.NUM(/1) 226 : NBELEM=IPT1.NUM(/2) 227 : DO 42 INBEL=1,NBELEM 228 : C 229 : C********** Boucle sur les elts 230 : C 231 : ICENT=ICENT+1 232 : NOCEN=MCENT.NUM(1,ICENT) 233 : DO 422 INBPO=1,NBPOEL 234 : C 235 : C************* Boucle sur les noeuds des elts 236 : C 237 : NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL)) 238 : IF (NOPOI1.NE.0) THEN 239 : LEPOEL.LESPOI(ICOUR.INDEX(NOPOI1))=NOCEN 240 : ICOUR.INDEX(NOPOI1)=ICOUR.INDEX(NOPOI1)+1 241 : ELSE 242 : C 243 : C**************** 'Erreur grave MCLPO1 n''est pas' 244 : C 'le maillage de points correspondant' 245 : C 'à MCLAS.' 246 : C Message d'erreur standard 247 : C 5 3 248 : C Erreur anormale.contactez votre support 249 : C 250 : MOTERR(1:40) = 251 : $ 'Subroutine poele2.eso ' 252 : WRITE(IOIMP,*) MOTERR(1:40) 252 : CALL ERREUR(5) 253 : GOTO 9999 254 : ENDIF 255 : 422 CONTINUE 256 : 42 CONTINUE 257 : IF (NBSOUS.GT.1) SEGDES IPT1 258 : 4 CONTINUE 259 : SEGDES MCLAS 260 : SEGDES MCENT 261 : C 262 : C On procède en bouclant sur les éléments de MCONT pour 263 : C remplir le tableau LESPOI. 264 : C 265 : SEGACT MCCEN 266 : SEGACT MCONT 267 : NBSOUS=MCONT.LISOUS(/1) 268 : IF (NBSOUS.EQ.0) NBSOUS=1 269 : ICENT=0 270 : DO 5 INBSOU=1,NBSOUS 271 : IF (NBSOUS.GT.1) THEN 272 : IPT1=MCONT.LISOUS(INBSOU) 273 : SEGACT IPT1 274 : ELSE 275 : IPT1=MCONT 276 : ENDIF 277 : NBPOEL=IPT1.NUM(/1) 278 : NBPOM1=NBPOEL - 1 279 : C 280 : C******* NOPOI1=KRIPO1.LECT(IPT1.NUM(NBPOEL,INBEL)) = CENTRE DE FACE 281 : C 282 : NBELEM=IPT1.NUM(/2) 283 : DO 52 INBEL=1,NBELEM 284 : ICENT=ICENT+1 285 : NOCEN=MCCEN.NUM(1,ICENT) 286 : NOCEN1 = IPT1.NUM(NBPOEL,INBEL) 287 : IF(NOCEN .NE. NOCEN1)THEN 288 : MOTERR(1:40) = 'Subroutine poele2.eso ' 289 : WRITE(IOIMP,*) MOTERR(1:40) 290 : C 291 : C****************Message d'erreur standard 292 : C 5 3 293 : C Erreur anormale.contactez votre support 294 : C 294 : CALL ERREUR(5) 295 : ENDIF 296 : DO 522 INBPO=1,NBPOM1 297 : NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL)) 298 : IF (NOPOI1.NE.0) THEN 299 : LEPOEL.LESPOI(ICOUR.INDEX(NOPOI1))=NOCEN 300 : ICOUR.INDEX(NOPOI1)=ICOUR.INDEX(NOPOI1)+1 301 : ENDIF 302 : 522 CONTINUE 303 : 52 CONTINUE 304 : IF (NBSOUS.GT.1) SEGDES IPT1 305 : 5 CONTINUE 306 : SEGDES MCONT 307 : SEGDES MCCEN 308 : C 309 : C**** Si tu as bien marche', ICOUR.INDEX(I) = LEPOEL.INDEX(I+1) 310 : C 311 : DO 6 INBL = 1, NBL 312 : IF(ICOUR.INDEX(INBL) .NE. LEPOEL.INDEX(INBL+1))THEN 313 : MOTERR(1:40) = 'Subroutine poele2.eso ' 314 : WRITE(IOIMP,*) MOTERR(1:40) 315 : C 316 : C************* Message d'erreur standard 317 : C 5 3 318 : C Erreur anormale.contactez votre support 319 : C 319 : CALL ERREUR(5) 320 : ENDIF 321 : 6 CONTINUE 322 : C 323 : C 324 : C**** Test 325 : C 326 : C WRITE(*,*) 'LEPOEL.INDEX',NBL+1 327 : C WRITE(*,*) (LEPOEL.INDEX(I),I=1,NBL+1) 328 : C WRITE(*,*) 'LEPOEL.LESPOI',NBTPOI 329 : C WRITE(*,*) (LEPOEL.LESPOI(I),I=1,NBTPOI) 330 : C 331 : SEGDES LEPOEL 332 : SEGSUP ICOUR 333 : SEGSUP KRIPO1 334 : 9999 CONTINUE 335 : RETURN 336 : * 337 : * End of subroutine POELE2 338 : * 339 : END 340 : 341 : 342 : 343 :
© Cast3M 2003 - All rights reserved.
Disclaimer