1 : C FFMCHA SOURCE CHAT 11/03/16 21:22:19 6902 2 : SUBROUTINE FFMCHA(MYMOD,INFOEL,MATR,ICHFAC,LTITR) 3 : C 4 : C 5 : C_________________________________________________________________ 6 : C NOM : InterFace Matrice->CHAmp par éléments 7 : C_________________________________________________________________ 8 : C OBJET : 9 : C INTERFACE INTERVENANT EN THERMIQUE (RAYONNEMENT) 10 : C_________________________________________________________________ 11 : C FONCTION : 12 : C PERMET DE PASSER D'UN MODELE (+ segment INFOEL) 13 : C ET DE LA MATRICE CONTENANT LES FACTEURS DE FORME 14 : C AU CHAMELEME CORRESPONDANT 15 : C_________________________________________________________________ 16 : C OPERANDES : 17 : C 18 : C en entrée : 19 : C MYMOD (MMODEL) MODELE SUR LEQUEL REPOSE MATR 20 : C INFOEL INFORMATIONS SUR LE TYPE DES ELEMENTS 21 : C !!!!! si on ne doit pas tenir compte du cas des 22 : C éléments COQ , ce pointeur doit être mis à 0 . 23 : C MATR (IFACFO) MATRICE CONTENANT LES FACTEURS DE FORME 24 : C OU LA MATRICE DE RAYONNEMENT 25 : C !!!!! chaque élément COQ donne lieu à 2 fois plus 26 : C de facteurs de forme qu'un élément normal . 27 : C de facteurs de forme qu'un élément normal . 28 : C LTITR entier definissant le titre du MCHAML 29 : C 'FACTEURS DE FORME ' 30 : C ou 'MATRICE DE RAYONNEMENT' 31 : C en sortie : 32 : C ICHFAC (MCHELM) CHAMELEM CONTENANT LES FACTEURS DE FORME 33 : C 34 : C_________________________________________________________________ 35 : C 36 : C 37 : IMPLICIT INTEGER(I-N) 38 : IMPLICIT REAL*8 (A-H,O-Z) 39 : C 40 : -INC CCOPTIO 41 : -INC SMCHAML 42 : -INC SMELEME 43 : -INC SMMODEL 44 : C 45 : C ___________________________________________________________ 46 : C FACTEURS DE FORME stockage sous forme matricielle 47 : C NNBEL1 = NOMBRE DE LIGNES + 1 48 : C NBEL2 = NOMBRE DE COLONNES 49 : C LFACT(NNBEL1) POINTE SUR LE TABLEAU DES SURFACES 50 : C 51 : SEGMENT IFACFO 52 : INTEGER LFACT(NNBEL1) 53 : ENDSEGMENT 54 : SEGMENT LFAC 55 : REAL*8 FACT(NBEL2) 56 : ENDSEGMENT 57 : C 58 : POINTEUR PSUR.LFAC, PLIG.LFAC, PLIGI.LFAC, PLIGS.LFAC 59 : POINTEUR MATR.IFACFO 60 : C ___________________________________________________________ 61 : C Stockage d'informations concernant le type des éléments des maillages 62 : SEGMENT ,INFOEL 63 : LOGICAL KCOQ(N1),KQUAD(N1) 64 : ENDSEGMENT 65 : C ___________________________________________________________ 66 : C 67 : POINTEUR MYMOD.MMODEL 68 : POINTEUR ISSM.MELEME 69 : POINTEUR ICHFAC.MCHELM , ICPEL.MCHELM 70 : POINTEUR MELVA7.MELVAL 71 : LOGICAL ICOQ 72 : LOGICAL LTEST1, LTEST2, LTEST3 73 : C_________________________________________________________________ 74 : C 75 : C STRUCTURE DU CHAMELEM 76 : C 77 : C MELVA3 : segment MELVAL , surface 78 : C -----1 : segment -----L partie haute du CHAMELEM 79 : C -----4 : segment -----L partie haute du CHAMELEM 80 : C 81 : C CAS DES ELEMENTS COQ pour la partie haute 82 : C -- Partie 'haute' du CHAMELEM : boucle A -- 83 : C MELVA1 : segment MELVAL , côté SUPE 84 : C MELVA2 : segment MELVAL , côté INFE 85 : C -- Partie 'basse' du CHAMELEM : boucle B -- 86 : C MCHEL4 : segment MCHELM , côté SUPE 87 : C MCHEL5 : segment MCHELM , côté INFE 88 : C MCHAM4 : segment MCHAML , côté SUPE 89 : C MCHAM5 : segment MCHAML , côté INFE 90 : C CAS DES ÉLÉMENTS COQ pour la partie basse 91 : C MELVA4 : segment MELVAL , côté SUPE , relié à MCHAM4 92 : C MELVA5 : segment MELVAL , côté INFE , relié à MCHAM4 93 : C MELVA6 : segment MELVAL , côté SUPE , relié à MCHAM5 94 : C MELVA7 : segment MELVAL , côté INFE , relié à MCHAM5 95 : C sinon 96 : C MELVA4 : segment MELVAL , relié à MCHAM4 97 : C MELVA6 : segment MELVAL , relié à MCHAM5 98 : C ----- 99 : C_________________________________________________________________ 100 : C 101 : C NOTATIONS : 102 : C 103 : C eA : élément de la boucle A (partie haute) 104 : C eB : élément de la boucle B (partie basse ) 105 : C eA+,eB+ : côté SUPE de l'élément 106 : C eA-,eB- : côté INFE de l'élément 107 : C_________________________________________________________________ 108 : C 109 : IF(IIMPI.GE.2) THEN 110 : WRITE (6,*) 'On est dans ffmcha' 111 : ENDIF 112 : C 113 : IF (INFOEL.EQ.0) THEN 114 : ICOQ = .FALSE. 115 : ELSE 116 : ICOQ = .TRUE. 117 : ENDIF 118 : C 119 : SEGACT MYMOD 120 : C 121 : C On construit l'information maillage du CHAMELEM 122 : L1 = 22 123 : N3 = 6 124 : N1 = MYMOD.KMODEL(/1) 125 : IF (N1.EQ.0) THEN 125 : CALL ERREUR(21) 126 : RETURN 127 : ENDIF 128 : C 129 : SEGINI ,ICPEL 130 : 131 : IF (LTITR.EQ.1) THEN 132 : ICPEL.TITCHE = 'FACTEURS DE FORME ' 133 : ELSE 134 : ICPEL.TITCHE = 'MATRICE DE RAYONNEMENT' 135 : ENDIF 136 : 137 : IF (IFOMOD.NE.0) THEN 138 : IF (IDIM.EQ.3) THEN 139 : ICPEL.IFOCHE = 2 140 : ELSE 141 : ICPEL.IFOCHE = -1 142 : ENDIF 143 : ELSE 144 : ICPEL.IFOCHE = 0 145 : ENDIF 146 : DO I=1,N1 147 : IMODE1 = MYMOD.KMODEL(I) 148 : SEGACT IMODE1 149 : ICPEL.IMACHE(I) = IMODE1.IMAMOD 150 : SEGDES IMODE1 151 : ENDDO 152 : SEGDES ICPEL 153 : SEGDES MYMOD 154 : C 155 : C------------------------------------------------------------ 156 : C 157 : C 158 : C On récupère le nombre total d'éléments . 159 : C On vérifiera que le maillage et la matrice 160 : C portent sur le même nombre d'éléments . 161 : SEGACT MATR 162 : NNBEL1 = MATR.LFACT(/1) 163 : NBEL2 = NNBEL1 - 1 164 : PSUR = MATR.LFACT(NNBEL1) 165 : SEGACT PSUR 166 : C 167 : SEGINI ,ICHFAC=ICPEL 168 : NUMA = 0 169 : C 170 : IF (ICOQ) SEGACT INFOEL 171 : C Pour les tests avenirs , on sait que FORTRAN évalue la partie 172 : C gauche d'une expression booléenne avant la partie droite , 173 : C et donc : 174 : C dans le cas d'un .AND. si la partie gauche est fausse 175 : C la partie droite ne sera pas évaluée . 176 : C ... La remarque ci-dessus s'est avérée fausse dans le cas de 177 : C certains compilateurs (DEC Alpha OSF ), d'où l'introduction des 178 : C variables logiques LTEST1, LTEST2 et LTEST3 qui permettent de se 179 : C passer de cette hypothèse (MB & LB 13/03/96) ... 180 : 181 : C 182 : C ----------------------------------------------------- 183 : DO NSMA=1,N1 184 : C On boucle sur les sous-champs 185 : C 186 : ISSM = ICHFAC.IMACHE(NSMA) 187 : SEGACT ISSM 188 : C NBPTA = ISSM.NUM(/1) 189 : NBELA = ISSM.NUM(/2) 190 : SEGDES ISSM 191 : N1EL = NBELA 192 : N1PTEL = 1 193 : N2EL = 0 194 : N2PTEL = 0 195 : SEGINI MELVA3 196 : N1EL = 0 197 : N1PTEL = 0 198 : N2EL = NBELA 199 : N2PTEL = 1 200 : C 201 : LTEST1=.FALSE. 202 : IF(ICOQ) THEN 203 : IF(KCOQ(NSMA)) LTEST1=.TRUE. 204 : ENDIF 205 : IF (LTEST1) THEN 206 : C 207 : C Cas des COQ pour la partie haute 208 : N2 = 3 209 : SEGINI ,MCHAM1 210 : ICHFAC.ICHAML(NSMA) = MCHAM1 211 : SEGINI ,MELVA1,MELVA2 212 : MCHAM1.NOMCHE(1) = 'SUPE' 213 : MCHAM1.TYPCHE(1) = 'POINTEURMCHAML' 214 : MCHAM1.IELVAL(1) = MELVA1 215 : MCHAM1.NOMCHE(2) = 'INFE' 216 : MCHAM1.TYPCHE(2) = 'POINTEURMCHAML' 217 : MCHAM1.IELVAL(2) = MELVA2 218 : MCHAM1.NOMCHE(3) = 'SURF' 219 : MCHAM1.TYPCHE(3) = 'REAL*8' 220 : MCHAM1.IELVAL(3) = MELVA3 221 : SEGDES MCHAM1 222 : 223 : C ---------------------------------------------- 224 : DO NELMA=1,NBELA 225 : C On boucle sur les éléments du sous-champs NSMA 226 : C 227 : C 228 : NUMA = NUMA + 1 229 : MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA) 230 : PLIGI = MATR.LFACT(NUMA) 231 : NUMA = NUMA + 1 232 : MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA) 233 : PLIGS = MATR.LFACT(NUMA) 234 : SEGACT ,PLIGI,PLIGS 235 : SEGINI ,MCHEL4=ICPEL 236 : MELVA1.IELCHE(1,NELMA) = MCHEL4 237 : SEGINI ,MCHEL5=ICPEL 238 : MELVA2.IELCHE(1,NELMA) = MCHEL5 239 : NUMB = 0 240 : C 241 : C -------------------------------------------- 242 : DO NSMB=1,N1 243 : C On boucle sur les sous-champs 244 : C 245 : ISSM = ICHFAC.IMACHE(NSMB) 246 : SEGACT ISSM 247 : C NBPTB = ISSM.NUM(/1) 248 : NBELB = ISSM.NUM(/2) 249 : N1EL = NBELB 250 : N1PTEL = 1 251 : N2EL = 0 252 : N2PTEL = 0 253 : SEGDES ISSM 254 : C 255 : LTEST2 = .FALSE. 256 : IF(ICOQ) THEN 257 : IF(KCOQ(NSMB)) LTEST2 = .TRUE. 258 : ENDIF 259 : IF (LTEST2) THEN 260 : C 261 : C Cas des COQ pour la partie basse 262 : N2 = 2 263 : SEGINI ,MCHAM4,MCHAM5 264 : MCHEL4.ICHAML(NSMB) = MCHAM4 265 : MCHEL5.ICHAML(NSMB) = MCHAM5 266 : C 267 : SEGINI ,MELVA4,MELVA5 268 : MCHAM4.NOMCHE(1) = 'SUPE' 269 : MCHAM4.TYPCHE(1) = 'REAL*8' 270 : MCHAM4.IELVAL(1) = MELVA4 271 : MCHAM4.NOMCHE(2) = 'INFE' 272 : MCHAM4.TYPCHE(2) = 'REAL*8' 273 : MCHAM4.IELVAL(2) = MELVA5 274 : SEGDES ,MCHAM4 275 : SEGINI ,MELVA6,MELVA7 276 : MCHAM5.NOMCHE(1) = 'SUPE' 277 : MCHAM5.TYPCHE(1) = 'REAL*8' 278 : MCHAM5.IELVAL(1) = MELVA6 279 : MCHAM5.NOMCHE(2) = 'INFE' 280 : MCHAM5.TYPCHE(2) = 'REAL*8' 281 : MCHAM5.IELVAL(2) = MELVA7 282 : SEGDES ,MCHAM5 283 : C 284 : C --------------------------------------- 285 : DO NELMB=1,NBELB 286 : C On boucle sur les éléments du sous-champs NSMB 287 : C 288 : C On copie la donnée facteur de forme 289 : NUMB = NUMB + 1 290 : C FF(eA+,eB+) 291 : MELVA4.VELCHE(1,NELMB) = PLIGI.FACT(NUMB) 292 : C FF(eA-,eB+) 293 : MELVA6.VELCHE(1,NELMB) = PLIGS.FACT(NUMB) 294 : NUMB = NUMB + 1 295 : C FF(eA+,eB-) 296 : MELVA5.VELCHE(1,NELMB) = PLIGI.FACT(NUMB) 297 : C FF(eA-,eB-) 298 : MELVA7.VELCHE(1,NELMB) = PLIGS.FACT(NUMB) 299 : C 300 : ENDDO 301 : C fin NELMB ---------------------------- 302 : C 303 : SEGDES ,MELVA4,MELVA5,MELVA6,MELVA7 304 : C 305 : ELSE 306 : C 307 : C Partie basse : pas d'éléments COQ 308 : N2 = 1 309 : SEGINI MCHAM4,MCHAM5 310 : MCHEL4.ICHAML(NSMB) = MCHAM4 311 : MCHEL5.ICHAML(NSMB) = MCHAM5 312 : SEGINI ,MELVA4,MELVA5 313 : MCHAM4.NOMCHE(1) = 'MIDL' 314 : MCHAM4.TYPCHE(1) = 'REAL*8' 315 : MCHAM4.IELVAL(1) = MELVA4 316 : MCHAM5.NOMCHE(1) = 'MIDL' 317 : MCHAM5.TYPCHE(1) = 'REAL*8' 318 : MCHAM5.IELVAL(1) = MELVA5 319 : SEGDES MCHAM4,MCHAM5 320 : C 321 : C --------------------------------------- 322 : DO NELMB=1,NBELB 323 : C On boucle sur les éléments du sous-champs NSMB 324 : C 325 : C On copie la donnée facteur de forme 326 : NUMB = NUMB + 1 327 : C FF(eA+,eB) 328 : MELVA4.VELCHE(1,NELMB) = PLIGI.FACT(NUMB) 329 : C FF(eA-,eB) 330 : MELVA5.VELCHE(1,NELMB) = PLIGS.FACT(NUMB) 331 : C 332 : ENDDO 333 : C fin NELMB ----------------------------- 334 : C 335 : SEGDES ,MELVA4,MELVA5 336 : C 337 : ENDIF 338 : C 339 : C 340 : ENDDO 341 : C fin NSMB ------------------------------------- 342 : C 343 : SEGDES ,MCHEL4,MCHEL5 344 : SEGDES ,PLIGI,PLIGS 345 : C 346 : ENDDO 347 : C fin NELMA --------------------------------------- 348 : C 349 : SEGDES ,MELVA1,MELVA2,MELVA3 350 : C 351 : ELSE 352 : C 353 : C Partie haute : pas d'éléments COQ 354 : SEGINI ,MELVA1 355 : N2 = 2 356 : SEGINI MCHAM1 357 : ICHFAC.ICHAML(NSMA) = MCHAM1 358 : MCHAM1.NOMCHE(1) = 'MIDL' 359 : MCHAM1.TYPCHE(1) = 'POINTEURMCHAML' 360 : MCHAM1.IELVAL(1) = MELVA1 361 : MCHAM1.NOMCHE(2) = 'SURF' 362 : MCHAM1.TYPCHE(2) = 'REAL*8' 363 : MCHAM1.IELVAL(2) = MELVA3 364 : SEGDES ,MCHAM1 365 : C 366 : C ---------------------------------------------- 367 : DO NELMA=1,NBELA 368 : C On boucle sur les éléments du sous-champs NSMA 369 : C 370 : C 371 : NUMA = NUMA + 1 372 : MELVA3.VELCHE(1,NELMA) = PSUR.FACT(NUMA) 373 : PLIG = MATR.LFACT(NUMA) 374 : SEGACT PLIG 375 : SEGINI ,MCHEL4=ICPEL 376 : MELVA1.IELCHE(1,NELMA) = MCHEL4 377 : NUMB = 0 378 : C 379 : C -------------------------------------------- 380 : DO NSMB=1,N1 381 : C On boucle sur les sous-champs 382 : C 383 : ISSM = ICHFAC.IMACHE(NSMB) 384 : SEGACT ISSM 385 : C NBPTB = ISSM.NUM(/1) 386 : NBELB = ISSM.NUM(/2) 387 : N1EL = NBELB 388 : N1PTEL = 1 389 : N2EL = 0 390 : N2PTEL = 0 391 : SEGDES ISSM 392 : C 393 : LTEST3 = .FALSE. 394 : IF(ICOQ) THEN 395 : IF(KCOQ(NSMB)) LTEST3 = .TRUE. 396 : ENDIF 397 : IF (LTEST3) THEN 398 : 399 : C 400 : C Cas des COQ pour la partie basse 401 : N2 = 2 402 : SEGINI ,MCHAM4 403 : MCHEL4.ICHAML(NSMB) = MCHAM4 404 : SEGINI ,MELVA4,MELVA5 405 : MCHAM4.NOMCHE(1) = 'SUPE' 406 : MCHAM4.TYPCHE(1) = 'REAL*8' 407 : MCHAM4.IELVAL(1) = MELVA4 408 : MCHAM4.NOMCHE(2) = 'INFE' 409 : MCHAM4.TYPCHE(2) = 'REAL*8' 410 : MCHAM4.IELVAL(2) = MELVA5 411 : SEGDES ,MCHAM4 412 : C 413 : C --------------------------------------- 414 : DO NELMB=1,NBELB 415 : C On boucle sur les éléments du sous-champs NSMB 416 : C 417 : C On copie la donnée facteur de forme 418 : NUMB = NUMB + 1 419 : C FF(eA,eB+) 420 : MELVA4.VELCHE(1,NELMB) = PLIG.FACT(NUMB) 421 : NUMB = NUMB + 1 422 : C FF(eA,eB-) 423 : MELVA5.VELCHE(1,NELMB) = PLIG.FACT(NUMB) 424 : C 425 : ENDDO 426 : C fin NELMB ----------------------------- 427 : C 428 : SEGDES ,MELVA4,MELVA5 429 : C 430 : ELSE 431 : C 432 : C Partie basse : pas d'éléments COQ 433 : N2 = 1 434 : SEGINI MCHAM4 435 : MCHEL4.ICHAML(NSMB) = MCHAM4 436 : SEGINI ,MELVA4 437 : MCHAM4.NOMCHE(1) = 'MIDL' 438 : MCHAM4.TYPCHE(1) = 'REAL*8' 439 : MCHAM4.IELVAL(1) = MELVA4 440 : SEGDES MCHAM4 441 : C 442 : C --------------------------------------- 443 : DO NELMB=1,NBELB 444 : C On boucle sur les éléments du sous-champs NSMB 445 : C 446 : C On copie la donnée facteur de forme 447 : NUMB = NUMB + 1 448 : C FF(eA,eB) 449 : MELVA4.VELCHE(1,NELMB) = PLIG.FACT(NUMB) 450 : C 451 : ENDDO 452 : C fin NELMB ----------------------------- 453 : C 454 : SEGDES ,MELVA4 455 : C 456 : ENDIF 457 : C 458 : C 459 : ENDDO 460 : C fin NSMB ------------------------------------- 461 : C 462 : SEGDES ,MCHEL4 463 : SEGDES ,PLIG 464 : C 465 : ENDDO 466 : C fin NELMA --------------------------------------- 467 : C 468 : SEGDES ,MELVA1,MELVA3 469 : C 470 : ENDIF 471 : C 472 : ENDDO 473 : C fin NSMA ---------------------------------------------- 474 : C 475 : C 476 : SEGDES ICHFAC 477 : SEGDES MATR , PSUR 478 : SEGSUP ICPEL 479 : C 480 : IF (ICOQ) SEGDES INFOEL 481 : C 482 : IF (NUMA.NE.NBEL2) THEN 482 : CALL ERREUR(21) 483 : C WRITE (6,*) 'Le maillage et la matrice portent sur un nombre' 484 : C # ,' différent d éléments .' 485 : ENDIF 486 : C 487 : RETURN 488 : END 489 : 490 : 491 : 492 : 493 : 494 : 495 : 496 : 497 :
© Cast3M 2003 - All rights reserved.
Disclaimer