1 : C RAYE1 SOURCE CHAT 12/06/07 21:15:55 7389 2 : SUBROUTINE RAYE1(ICHFAC, INFOEL, MATR) 3 : 4 : C ********************************************************** 5 : C **** SUBROUTINE D'INTERFACAGE CHAMELEM --> MATRICE **** 6 : C **** POUR LES FACTEURS DE FORME **** 7 : C **** **** 8 : C **** En entree : ICHFAC matrice des facteurs de **** 9 : C **** de type CHAMELEM **** 10 : C **** INFOEL segment qui contient la **** 11 : C **** structure COQ ou QUAdratique de la **** 12 : C **** zone étudiée **** 13 : C **** **** 14 : C **** En sortie : MATR matrice des facteurs de forme **** 15 : C **** exploitable par le programme **** 16 : C **** de calcul RAYE3.ESO **** 17 : C **** **** 18 : C ********************************************************** 19 : 20 : IMPLICIT INTEGER(I-N) 21 : IMPLICIT REAL*8 (A-H,O-Z) 22 : 23 : -INC SMCHAML 24 : -INC SMELEME 25 : -INC CCOPTIO 26 : 27 : C ********************************************************** 28 : C **** Declaration de la structure des facteurs **** 29 : C **** de forme **** 30 : C ********************************************************** 31 : 32 : SEGMENT IFACFO 33 : INTEGER LFACT(NBEL1) 34 : ENDSEGMENT 35 : SEGMENT LFAC 36 : REAL*8 FACT(NBEL2) 37 : ENDSEGMENT 38 : 39 : SEGMENT INFOEL 40 : LOGICAL KCOQ(N1), KQUAD(N1) 41 : ENDSEGMENT 42 : 43 : C ********************************************************** 44 : C **** Declaration des variables du probleme **** 45 : C ********************************************************** 46 : 47 : POINTEUR PSUR.LFAC, PLIGI.LFAC, PLIGS.LFAC, PLIG.LFAC 48 : POINTEUR MATR.IFACFO 49 : 50 : POINTEUR ISSM.MELEME 51 : POINTEUR ICHFAC.MCHELM 52 : POINTEUR IMCHFA.MCHAML 53 : POINTEUR ISURF.MELVAL 54 : 55 : C **** Cas des elements COQ en haut **** 56 : 57 : POINTEUR IFFAS.MELVAL, IFFAI.MELVAL 58 : POINTEUR ISSCHI.MCHELM, ISSCHS.MCHELM 59 : POINTEUR ICHFBI.MCHAML, ICHFBS.MCHAML 60 : 61 : C **** Cas des elements COQ en haut et en bas **** 62 : 63 : POINTEUR IFFBII.MELVAL, IFFBIS.MELVAL 64 : POINTEUR IFFBSI.MELVAL, IFFBSS.MELVAL 65 : 66 : C **** Cas des elements COQ en haut seulement **** 67 : 68 : POINTEUR IFFBIM.MELVAL, IFFBSM.MELVAL 69 : 70 : 71 : 72 : 73 : C **** Pas d'elements COQ en haut **** 74 : 75 : POINTEUR IFFA.MELVAL 76 : POINTEUR ISSCH.MCHELM 77 : POINTEUR ICHFB.MCHAML 78 : 79 : C **** Cas des elements COQ en bas seulement **** 80 : 81 : POINTEUR IFFBI.MELVAL, IFFBS.MELVAL 82 : 83 : C **** Cas ou il n'y a pas d'elements COQ **** 84 : 85 : POINTEUR IFFB.MELVAL 86 : 87 : C ********************************************************** 88 : C **** Recherche de la position du pointeur donnant **** 89 : C **** les surfaces des elements **** 90 : C ********************************************************** 91 : 92 : IF (IIMPI.GE.4) WRITE(6,*) 'DEBUT DE RAYE1.ESO' 93 : 94 : SEGACT ICHFAC 95 : NBS = ICHFAC.IMACHE(/1) 96 : C **** NBS designe le nombre de sous maillages de type **** 97 : C **** tri3, qua4 ... **** 98 : 99 : SEGACT INFOEL 100 : NBEL = 0 101 : DO 10 I = 1, NBS 102 : ISSM = ICHFAC.IMACHE(I) 103 : SEGACT ISSM 104 : NBEL = NBEL + ISSM.NUM(/2) 105 : IF (KCOQ(I)) THEN 106 : C **** S'il y a des elements COQ, on rajoute **** 107 : C **** une ligne. **** 108 : NBEL = NBEL + ISSM.NUM(/2) 109 : ENDIF 110 : 111 : SEGDES ISSM 112 : 10 CONTINUE 113 : SEGDES INFOEL 114 : 115 : C **** NBEL designe le nombre total d'elements sur la **** 116 : C **** frontiere du maillage **** 117 : 118 : NBEL1 = NBEL + 1 119 : C **** On rajoute une dimension a la matrice MATR pour **** 120 : C **** stocker la ligne donnant la surface des elements**** 121 : C **** On a donc une matrice de taille NBEL*(NBEL+1) **** 122 : 123 : SEGINI MATR 124 : 125 : C ********************************************************** 126 : C **** Interface CHAMELEM --> MATRICE **** 127 : C ********************************************************** 128 : 129 : C ********************************************************** 130 : C **** PASSAGE DES VALEURS DES SURFACES **** 131 : C **** On calcule d'abord la dimension du vecteur PSUR **** 132 : C **** Theoriquement, on doit trouver Nbel. Par **** 133 : C **** precaution, on le verifie. **** 134 : C ********************************************************** 135 : 136 : SEGACT INFOEL 137 : NBEL2 = 0 138 : 139 : DO 20 NSMA = 1, NBS 140 : IMCHFA = ICHFAC.ICHAML(NSMA) 141 : meleme=ichfac.imache(NSMA) 142 : segact meleme 143 : nbela= num(/2) 144 : SEGACT IMCHFA 145 : IF (KCOQ(NSMA)) then 146 : nbela=nbela*2 147 : ISURF = IMCHFA.IELVAL(3) 148 : 149 : else 150 : ISURF = IMCHFA.IELVAL(2) 151 : endif 152 : SEGDES IMCHFA 153 : nbel2=nbel2+nbela 154 : 20 continue 155 : C ********************************************************** 156 : C **** Si on a des elements COQ **** 157 : C ********************************************************** 158 : * SEGACT IMCHFA 159 : * ISURF = IMCHFA.IELVAL(3) 160 : * SEGDES IMCHFA 161 : * 162 : * SEGACT ISURF 163 : * NBELA = ISURF.VELCHE(/2) 164 : C Rajout du doublement des surfaces 165 : * NBELA = NBELA + NBELA 166 : * SEGDES ISURF 167 : * 168 : C SI KCOQ(NSMA) = FALSE 169 : * ELSE 170 : * 171 : C ********************************************************** 172 : C **** Si on n'a pas d'elements COQ **** 173 : C ********************************************************** 174 : * 175 : * SEGACT IMCHFA 176 : * ISURF = IMCHFA.IELVAL(2) 177 : * SEGDES IMCHFA 178 : * 179 : * SEGACT ISURF 180 : * NBELA = ISURF.VELCHE(/2) 181 : * SEGDES ISURF 182 : * 183 : * ENDIF 184 : * 185 : * NBEL2 = NBEL2 + NBELA 186 : * 187 : * 20 CONTINUE 188 : IF (IIMPI.GE.4.AND.NBEL.NE.NBEL2) THEN 189 : WRITE(6,*) 'Dimensions incompatibles' 190 : ENDIF 191 : 192 : SEGINI PSUR 193 : 194 : K = 0 195 : 196 : C **** Apres avoir verifie les dimensions, on passe **** 197 : C **** les valeurs dans le vecteur PSUR. **** 198 : 199 : DO 30 NSMA = 1, NBS 200 : IMCHFA = ICHFAC.ICHAML(NSMA) 201 : meleme= ICHFAC.imache(nsma) 202 : 203 : IF (KCOQ(NSMA)) THEN 204 : 205 : C ********************************************************** 206 : C **** Si on a des elements COQ **** 207 : C ********************************************************** 208 : 209 : SEGACT IMCHFA 210 : ISURF = IMCHFA.IELVAL(3) 211 : SEGDES IMCHFA 212 : SEGACT ISURF 213 : NBELA = ISURF.VELCHE(/2) 214 : 215 : DO 40 I = 1, Num(/2) 216 : K = K + 1 217 : ima= min ( i,nbela) 218 : PSUR.FACT(K) = ISURF.VELCHE(1,Ima) 219 : K = K + 1 220 : ima= min ( i,nbela) 221 : PSUR.FACT(K) = ISURF.VELCHE(1,Ima) 222 : IF (IIMPI.GE.4) THEN 223 : WRITE(6,*) 'SURF = ', ISURF.VELCHE(1,Ima) 224 : ENDIF 225 : 40 CONTINUE 226 : SEGDES ISURF 227 : 228 : C SI KCOQ(NSMA) = FALSE 229 : ELSE 230 : 231 : C ********************************************************** 232 : C **** Si on n'a pas d'elements COQ **** 233 : C ********************************************************** 234 : 235 : SEGACT IMCHFA 236 : ISURF = IMCHFA.IELVAL(2) 237 : SEGDES IMCHFA 238 : 239 : SEGACT ISURF 240 : NBELA = ISURF.VELCHE(/2) 241 : DO 45 I = 1, Num(/2) 242 : K = K + 1 243 : ima= min( i,nbela) 244 : PSUR.FACT(K) = ISURF.VELCHE(1,Ima) 245 : IF (IIMPI.GE.4) THEN 246 : WRITE(6,*) 'SURF 2= ', ISURF.VELCHE(1,Ima) 247 : ENDIF 248 : 45 CONTINUE 249 : SEGDES ISURF 250 : ENDIF 251 : 252 : 30 CONTINUE 253 : 254 : C **** Le vecteur PSUR est de dimension K et est place **** 255 : C **** en derniere ligne de MATR. **** 256 : 257 : IF (IIMPI.GE.4.AND.K.NE.NBEL2) THEN 258 : WRITE(6,*) 'K = ',K ,'NBEL2 = ', NBEL2 259 : WRITE(6,*) 'Ces deux nombres doivent etre egaux' 260 : ENDIF 261 : 262 : MATR.LFACT(NBEL1) = PSUR 263 : 264 : SEGDES PSUR 265 : 266 : C ********************************************************** 267 : C **** PASSAGE DES VALEURS DES FACTEURS DE FORME **** 268 : C ********************************************************** 269 : 270 : C ********************************************************** 271 : C **** On se positionne d'abord dans un sous-domaine **** 272 : C ********************************************************** 273 : 274 : I = 0 275 : 276 : C **** I designe l'indice de la ligne I de la matrice **** 277 : C **** MATR. **** 278 : 279 : DO 50 NSMA = 1, NBS 280 : IMCHFA = ICHFAC.ICHAML(NSMA) 281 : 282 : IF (IIMPI.GE.4) THEN 283 : WRITE(6,*) 'DIM INFOEL =', INFOEL.KCOQ(/1) 284 : WRITE(6,*) 'KCOQ = ', KCOQ(NSMA) 285 : ENDIF 286 : 287 : IF (KCOQ(NSMA)) THEN 288 : 289 : C ********************************************************** 290 : C **** Si on a des elements COQ dans la partie sup **** 291 : C ********************************************************** 292 : 293 : SEGACT IMCHFA 294 : IFFAS = IMCHFA.IELVAL(1) 295 : IFFAI = IMCHFA.IELVAL(2) 296 : SEGDES IMCHFA 297 : 298 : SEGACT IFFAS, IFFAI 299 : NBELA = IFFAS.IELCHE(/2) 300 : 301 : IF (IIMPI.GE.4) THEN 302 : WRITE(6,*) 'NBELA = ',NBELA 303 : ENDIF 304 : 305 : C **** NBELA designe le nombre d'elements du sous **** 306 : C **** domaine d'indice NSMA. **** 307 : 308 : C ********************************************************** 309 : C **** Puis, on pointe sur les numeros des elements du **** 310 : C **** maillage **** 311 : C ********************************************************** 312 : 313 : DO 60 NELMA = 1, NBELA 314 : I = I + 1 315 : ISSCHS = IFFAS.IELCHE(1,NELMA) 316 : ISSCHI = IFFAI.IELCHE(1,NELMA) 317 : 318 : SEGINI PLIGI, PLIGS 319 : SEGACT ISSCHS 320 : NBS2 = ISSCHS.ICHAML(/1) 321 : 322 : SEGACT ISSCHI 323 : NBS3 = ISSCHI.ICHAML(/1) 324 : IF (NBS2.NE.NBS3) THEN 325 : WRITE(6,*) 'Erreur de dimension' 326 : ENDIF 327 : 328 : J = 0 329 : 330 : C **** J designe l'indice de la colonne J de la **** 331 : C **** matrice MATR. **** 332 : 333 : DO 70 NSMB = 1, NBS2 334 : IF (KCOQ(NSMB)) THEN 335 : 336 : C **** S'il y a des elements COQ dans la partie inf **** 337 : 338 : ICHFBI = ISSCHI.ICHAML(NSMB) 339 : ICHFBS = ISSCHS.ICHAML(NSMB) 340 : 341 : SEGACT ICHFBI 342 : IFFBII = ICHFBI.IELVAL(1) 343 : IFFBIS = ICHFBI.IELVAL(2) 344 : SEGDES ICHFBI 345 : 346 : SEGACT ICHFBS 347 : 348 : IFFBSI = ICHFBS.IELVAL(1) 349 : IFFBSS = ICHFBS.IELVAL(2) 350 : SEGDES ICHFBS 351 : 352 : SEGACT IFFBII, IFFBIS 353 : SEGACT IFFBSI, IFFBSS 354 : NBELB = IFFBSI.VELCHE(/2) 355 : C ********************************************************** 356 : C **** Et enfin, on pointe sur une surface de ce **** 357 : C **** deuxieme domaine. **** 358 : C ********************************************************** 359 : 360 : DO 80 NELB = 1, NBELB 361 : J = J + 1 362 : PLIGI.FACT(J) = IFFBIS.VELCHE(1,NELB) 363 : PLIGS.FACT(J) = IFFBSS.VELCHE(1,NELB) 364 : J = J + 1 365 : PLIGI.FACT(J) = IFFBII.VELCHE(1,NELB) 366 : PLIGS.FACT(J) = IFFBSI.VELCHE(1,NELB) 367 : 80 CONTINUE 368 : 369 : SEGDES IFFBII, IFFBIS 370 : SEGDES IFFBSI, IFFBSS 371 : 372 : C **** On a boucle sur tous les elements du sous **** 373 : C **** maillage d'indice NSMB. **** 374 : 375 : 376 : C **** si KCOQ(NSMB) = FALSE **** 377 : 378 : ELSE 379 : 380 : C **** S'il n'y a pas d'elements COQ dans la partie inf**** 381 : 382 : ICHFBI = ISSCHI.ICHAML(NSMB) 383 : ICHFBS = ISSCHS.ICHAML(NSMB) 384 : 385 : SEGACT ICHFBI 386 : IFFBIM = ICHFBI.IELVAL(1) 387 : SEGDES ICHFBI 388 : 389 : SEGACT ICHFBS 390 : IFFBSM = ICHFBS.IELVAL(1) 391 : SEGDES ICHFBS 392 : 393 : 394 : SEGACT IFFBSM, IFFBIM 395 : NBELB = IFFBSM.VELCHE(/2) 396 : DO 90 NELB = 1, NBELB 397 : J = J + 1 398 : PLIGI.FACT(J) = IFFBIM.VELCHE(1,NELB) 399 : PLIGS.FACT(J) = IFFBSM.VELCHE(1,NELB) 400 : 90 CONTINUE 401 : 402 : SEGDES IFFBIM, IFFBSM 403 : 404 : ENDIF 405 : 406 : 70 CONTINUE 407 : 408 : C **** Test de verification **** 409 : 410 : IF (IIMPI.GE.4) THEN 411 : WRITE(6,*) 'Dimension du vecteur fforme =',J 412 : ENDIF 413 : 414 : C **** On a boucle sur tous les sous maillages. **** 415 : 416 : SEGDES ISSCHS, ISSCHI 417 : 418 : MATR.LFACT(I) = PLIGS 419 : I = I + 1 420 : MATR.LFACT(I) = PLIGI 421 : 422 : SEGDES PLIGI, PLIGS 423 : 424 : 60 CONTINUE 425 : 426 : SEGDES IFFAI, IFFAS 427 : 428 : C **** si KCOQ(NSMA) = FALSE **** 429 : 430 : ELSE 431 : 432 : IF (IIMPI.GE.4) THEN 433 : WRITE(6,*) 'il n''y a pas d''elements COQ en haut' 434 : ENDIF 435 : 436 : C ********************************************************** 437 : C **** SI ON N'A PAS D'ELEMENTS COQ DANS LA PARTIE SUP **** 438 : C ********************************************************** 439 : 440 : SEGACT IMCHFA 441 : IFFA = IMCHFA.IELVAL(1) 442 : SEGDES IMCHFA 443 : 444 : SEGACT IFFA 445 : NBELA = IFFA.IELCHE(/2) 446 : 447 : IF (IIMPI.GE.4) THEN 448 : WRITE(6,*) 'NBELA = ',NBELA 449 : ENDIF 450 : 451 : C **** NBELA designe le nombre d'elements du sous **** 452 : C **** domaine d'indice NSMA. **** 453 : 454 : C ********************************************************** 455 : C **** Puis, on pointe sur les numeros des elements du **** 456 : C **** maillage **** 457 : C ********************************************************** 458 : 459 : DO 160 NELMA = 1, NBELA 460 : I = I + 1 461 : ISSCH = IFFA.IELCHE(1,NELMA) 462 : 463 : SEGINI PLIG 464 : 465 : SEGACT ISSCH 466 : J = 0 467 : 468 : C **** J designe l'indice de la colonne J de la **** 469 : C **** matrice MATR. **** 470 : 471 : NBS2 = ISSCH.ICHAML(/1) 472 : 473 : C **** Theoriquement, NBS2 = NBS. **** 474 : 475 : IF (IIMPI.GE.4.AND.NBS.NE.NBS2) THEN 476 : WRITE(6,*) 'Probleme de dimension' 477 : ENDIF 478 : 479 : DO 170 NSMB = 1, NBS2 480 : ICHFB = ISSCH.ICHAML(NSMB) 481 : 482 : IF (KCOQ(NSMB)) THEN 483 : 484 : C **** S'il y a des elements COQ dans la partie inf **** 485 : 486 : SEGACT ICHFB 487 : IFFBI = ICHFB.IELVAL(1) 488 : IFFBS = ICHFB.IELVAL(2) 489 : SEGDES ICHFB 490 : 491 : SEGACT IFFBI 492 : NBELB = IFFBI.VELCHE(/2) 493 : SEGACT IFFBS 494 : DO 180 NELB = 1, NBELB 495 : J = J + 1 496 : PLIG.FACT(J) = IFFBS.VELCHE(1,NELB) 497 : J = J + 1 498 : PLIG.FACT(J) = IFFBI.VELCHE(1,NELB) 499 : 180 CONTINUE 500 : 501 : SEGDES IFFBI, IFFBS 502 : 503 : C **** On a boucle sur tous les elements du sous **** 504 : C **** maillage d'indice NSMB. **** 505 : 506 : C **** si KCOQ(NSMB) = FALSE **** 507 : 508 : ELSE 509 : 510 : C **** S'il n'y a pas d'elements COQ dans la partie inf**** 511 : 512 : SEGACT ICHFB 513 : IFFB = ICHFB.IELVAL(1) 514 : SEGDES ICHFB 515 : 516 : SEGACT IFFB 517 : NBELB = IFFB.VELCHE(/2) 518 : DO 190 NELB = 1, NBELB 519 : J = J + 1 520 : PLIG.FACT(J) = IFFB.VELCHE(1,NELB) 521 : 190 CONTINUE 522 : 523 : SEGDES IFFB 524 : 525 : ENDIF 526 : 527 : 170 CONTINUE 528 : 529 : C **** Test de verification **** 530 : 531 : IF (J.NE.NBEL2) THEN 532 : WRITE(6,*) 'Erreur de dimension' 533 : ENDIF 534 : 535 : C **** On a boucle sur tous les sous maillages. **** 536 : 537 : SEGDES ISSCH 538 : MATR.LFACT(I) = PLIG 539 : SEGDES PLIG 540 : 541 : 160 CONTINUE 542 : 543 : 544 : C **** On a boucle sur tous les elements du sous **** 545 : C **** maillage d'indice NSMA. **** 546 : 547 : SEGDES IFFA 548 : ENDIF 549 : 550 : 50 CONTINUE 551 : 552 : C **** Test de verification **** 553 : 554 : IF (IIMPI.GE.4.AND.I.NE.NBEL2) THEN 555 : WRITE(6,*) 'Erreur de dimension' 556 : ENDIF 557 : 558 : C **** On a boucle sur tous les sous maillages. **** 559 : 560 : C ********************************************************** 561 : C **** Desactivation des segments inutiles **** 562 : C ********************************************************** 563 : 564 : 565 : SEGDES MATR, INFOEL 566 : SEGDES ICHFAC 567 : 568 : SEGDES IMCHFA 569 : 570 : IF (IIMPI.GE.4) WRITE(6,*) 'FIN DE RAYE1.ESO OK' 571 : 572 : RETURN 573 : END 574 : 575 : 576 : 577 :
© Cast3M 2003 - All rights reserved.
Disclaimer