1 : C CMCT3 SOURCE GOUNAND 11/06/14 21:15:06 7005 2 : SUBROUTINE CMCT3(ICHP,IRIGC,IRIGB,IRIG2) 3 : *_______________________________________________________________________ 4 : c 5 : c opérateur cmct 6 : c 7 : c entrée 8 : c ICHP : champ par point qui stocke la masse inversée M-1 9 : c IRIGB : rigidité B 10 : c IRIGC : rigidité C 11 : c 12 : c sortie 13 : c IRIG2 : rigidité contenant la matrice condensée C M-1 Bt 14 : c 15 : *_______________________________________________________________________ 16 : 17 : IMPLICIT INTEGER(I-N) 18 : IMPLICIT REAL*8(A-H,O-Z) 19 : * 20 : -INC CCOPTIO 21 : -INC SMRIGID 22 : -INC SMELEME 23 : -INC CCHAMP 24 : -INC SMCOORD 25 : -INC SMCHPOI 26 : * 27 : * Description des objets à traiter 28 : * PNTOB : pointeur de l'objet 29 : * TYPOB : type de l'objet 30 : * PNTCOB : pointeur vers une version locale de l'objet 31 : * pour la RIGIDITE IMAT 32 : * PNTCOB(1,IMAT) pointe vers un CORES1 33 : * PNTCOB(2,IMAT) pointe vers un LSINCO 34 : * PNTCOB(3,IMAT) pointe vers un MCOEF 35 : 36 : SEGMENT DESCOB 37 : INTEGER PNTOB(NMAT) 38 : INTEGER PNTCOB(4,NMAT) 39 : ENDSEGMENT 40 : 41 : * stockage des noms de tous les composantes primales. 42 : SEGMENT LSINCP 43 : CHARACTER*4 LISINP(NLIGP) 44 : ENDSEGMENT 45 : * LPSINP(ILIGP,IOBJ) dit si la composante est présente dans l'objet 46 : * IOBJ (Matrice IRIGB, IRIGC ou ICHP) 47 : ** LPSINP(ILIGP,NOBJ+1) dit si la composante est présente dans 48 : ** tous les objets 49 : SEGMENT LLINCP 50 : LOGICAL LLSINP(NLIGP,NOBJ) 51 : ENDSEGMENT 52 : 53 : * stockage des noms des composantes duales. 54 : SEGMENT LSINCD 55 : CHARACTER*4 LISIND(NLIGD) 56 : ENDSEGMENT 57 : * 58 : * Noms d'inconnues primales correspondant à LISIND 59 : * 60 : SEGMENT CORIDP 61 : CHARACTER*4 LISIDP(NLIGD) 62 : ENDSEGMENT 63 : 64 : * correspondance entre les noms de composantes locale LISINC 65 : * et les noms de composantes dans LSINCP pour les RIGIDITES 66 : SEGMENT CORES1 67 : INTEGER IPCOR2(NRIGEL) 68 : ENDSEGMENT 69 : SEGMENT CORES2 70 : INTEGER COR2P(NLIGRP) 71 : INTEGER COR2D(NLIGRD) 72 : ENDSEGMENT 73 : * 74 : * tableau pour dire en chaque point si la composante du tableau LISINP 75 : * est impliquée 76 : * 77 : SEGMENT MTOPTS 78 : * nombre d'occurence de la composante 79 : INTEGER ITOPTS(NBPTS,NLIGP+1,NMAT) 80 : ENDSEGMENT 81 : SEGMENT NTOPTS 82 : * valeur de l'inverse la masse en ce point 83 : REAL*8 XTOPTS(NBPTS,NLIGP+1) 84 : ENDSEGMENT 85 : SEGMENT OTOPTS 86 : * valeur de l'inverse la masse en ce point 87 : LOGICAL LTOPTS(NBPTS,NLIGP+1) 88 : ENDSEGMENT 89 : * 90 : * tableau pour pointer vers MCOEF à partir du nombre d'inconnues 91 : * 92 : SEGMENT LSINCO 93 : INTEGER LESINC(NINC+1,2,NMAT) 94 : ENDSEGMENT 95 : SEGMENT LTINCO 96 : REAL*8 XMAS(NINC) 97 : ENDSEGMENT 98 : * 99 : * tableau des coefficient de la matrice C 100 : * ordonné dans l'ordre des inconnues 101 : SEGMENT MCOEF 102 : * numero du noeud support du multiplicateur ligne 1 103 : INTEGER ICOEF(2,NCOEF) 104 : * valeur des coefficients 105 : REAL*8 XCOEF(NCOEF) 106 : ENDSEGMENT 107 : * 108 : SEGMENT WORK1 109 : REAL*8 XDUM(NBNN) 110 : ENDSEGMENT 111 : LOGICAL NOER,LOK,LDBG,LTYP22 112 : * 113 : LDBG=.FALSE. 114 : NMAT=1 115 : IF (IRIGB.NE.IRIGC) NMAT=2 116 : NOBJ=NMAT 117 : IF (ICHP.NE.0) NOBJ=NMAT+1 118 : IF (LDBG) THEN 119 : WRITE(IOIMP,*) 'NMAT=',NMAT 120 : WRITE(IOIMP,*) 'NOBJ=',NOBJ 121 : ENDIF 122 : SEGINI DESCOB 123 : PNTOB(1)=IRIGC 124 : IF (IRIGB.NE.IRIGC) THEN 125 : PNTOB(2)=IRIGB 126 : ENDIF 127 : *_______________________________________________________________________ 128 : * 129 : * la première etape consiste à établir la liste de tous les noms 130 : * d'inconnue primale communes à la (aux) rigidités et à l'éventuel 131 : * CHPOINT de masse. Cette liste est stockée dans LSINCP. 132 : * On fait aussi la liste des duales par la même occasion 133 : * On regarde aussi s'il n'y a que des MELEME de type 22, auquel cas 134 : * on peut éviter le compactage du MCOEF (on est sûr que tous les ddls 135 : * duaux sont distincts) 136 : * 137 : * Calcul du nombre maxi 138 : NLIGP = 1000 139 : SEGINI LSINCP,LLINCP 140 : NLIGD = 1000 141 : SEGINI LSINCD 142 : LTYP22=.TRUE. 143 : * 144 : NLIGP1 = 0 145 : NLIGD1 = 0 146 : DO IMAT=1,NMAT 147 : MRIGID=PNTOB(IMAT) 148 : SEGACT MRIGID 149 : NRIGEL=IRIGEL(/2) 150 : DO I=1,NRIGEL 151 : MELEME = IRIGEL(1,I) 152 : SEGACT MELEME 153 : LTYP22=LTYP22.AND.(ITYPEL.EQ.22) 154 : DESCR = IRIGEL(3,I) 155 : SEGACT DESCR 156 : NLIGRP=LISINC(/2) 157 : IDEB=1 158 : IF (ITYPEL.EQ.22) IDEB=2 159 : DO 200 ILIGRP=IDEB,NLIGRP 160 : DO ILIGP1=1,NLIGP1 161 : IF (LISINC(ILIGRP).EQ.LISINP(ILIGP1)) THEN 162 : LLSINP(ILIGP1,IMAT)=.TRUE. 163 : GOTO 200 164 : ENDIF 165 : ENDDO 166 : * Petite astuce car on ne cherche que les composantes primales communes 167 : * à tous les objets donc pas besoin de concaténer celles au-delà 168 : * du premier objet 169 : IF (IMAT.EQ.1) THEN 170 : NLIGP1 = NLIGP1 + 1 171 : IF (NLIGP1.GT.NLIGP) THEN 172 : NLIGP=NLIGP+1000 173 : SEGADJ LSINCP,LLINCP 174 : ENDIF 175 : LISINP(NLIGP1) = LISINC(ILIGRP) 176 : LLSINP(NLIGP1,IMAT)=.TRUE. 177 : ENDIF 178 : 200 CONTINUE 179 : NLIGRD=LISDUA(/2) 180 : IF (ITYPEL.EQ.22) NLIGRD=1 181 : DO 202 ILIGRD=1,NLIGRD 182 : DO ILIGD1=1,NLIGD1 183 : IF (LISDUA(ILIGRD).EQ.LISIND(ILIGD1)) GOTO 202 184 : ENDDO 185 : NLIGD1 = NLIGD1 + 1 186 : IF (NLIGD1.GT.NLIGD) THEN 187 : NLIGD=NLIGD+1000 188 : SEGADJ LSINCD 189 : ENDIF 190 : LISIND(NLIGD1) = LISDUA(ILIGRD) 191 : 202 CONTINUE 192 : SEGDES DESCR 193 : SEGDES MELEME 194 : ENDDO 195 : SEGDES MRIGID 196 : ENDDO 197 : IF (ICHP.NE.0) THEN 198 : MCHPOI=ICHP 199 : SEGACT MCHPOI 200 : NSOUPO=IPCHP(/1) 201 : DO ISOUPO=1,NSOUPO 202 : MSOUPO=IPCHP(ISOUPO) 203 : SEGACT MSOUPO 204 : NC=NOCOMP(/2) 205 : DO 204 IC=1,NC 206 : DO ILIGP1=1,NLIGP1 207 : IF (NOCOMP(IC).EQ.LISINP(ILIGP1)) THEN 208 : LLSINP(ILIGP1,NOBJ)=.TRUE. 209 : GOTO 204 210 : ENDIF 211 : ENDDO 212 : 204 CONTINUE 213 : SEGDES MSOUPO 214 : ENDDO 215 : SEGDES MCHPOI 216 : ENDIF 217 : * 218 : IF (LDBG) THEN 219 : WRITE(IOIMP,*) 'LTYP22=',LTYP22 220 : WRITE(IOIMP,*) 'Liste des inconnues avant compactage' 221 : WRITE(IOIMP,*) ' 1) Duales' 222 : WRITE (IOIMP,2019) (LISIND(I),I=1,NLIGD1) 223 : WRITE(IOIMP,*) ' 2) Primales' 224 : WRITE (IOIMP,2019) (LISINP(I),I=1,NLIGP1) 225 : do j=1,nobj 226 : WRITE(IOIMP,*) ' Presence de la composante primale dans ', 227 : $ 'l''objet ',j 228 : WRITE (IOIMP,2021) (LLSINP(I,j),I=1,NLIGP1) 229 : enddo 230 : ENDIF 231 : * On compacte LSINCD 232 : NLIGD = NLIGD1 233 : SEGADJ LSINCD 234 : * On compacte LSINCP 235 : NLIGP = 0 236 : DO ILIGP1=1,NLIGP1 237 : LOK=.TRUE. 238 : DO IOBJ=1,NOBJ 239 : LOK=LOK.AND.LLSINP(ILIGP1,IOBJ) 240 : ENDDO 241 : IF (LOK) THEN 242 : NLIGP=NLIGP+1 243 : IF (ILIGP1.NE.NLIGP) LISINP(NLIGP)=LISINP(ILIGP1) 244 : ENDIF 245 : ENDDO 246 : SEGADJ LSINCP 247 : SEGSUP LLINCP 248 : IF (LDBG) THEN 249 : WRITE(IOIMP,*) 'Primales apres compactage' 250 : WRITE (IOIMP,2019) (LISINP(I),I=1,LISINP(/2)) 251 : ENDIF 252 : * On sort de manière anticipée s'il n'y a pas d'inconnues primales 253 : * communes 254 : IF (NLIGP.EQ.0) THEN 255 : SEGSUP DESCOB,LSINCP,LSINCD 256 : GOTO 9999 257 : ENDIF 258 : * 259 : * Les correspondances locale -> globale dans CORES1 pour les RIGIDITES 260 : * 261 : DO IMAT=1,NMAT 262 : MRIGID=PNTOB(IMAT) 263 : SEGACT MRIGID 264 : NRIGEL=IRIGEL(/2) 265 : SEGINI CORES1 266 : DO I=1,NRIGEL 267 : MELEME = IRIGEL(1,I) 268 : SEGACT MELEME 269 : DESCR = IRIGEL(3,I) 270 : SEGACT DESCR 271 : NLIGRP=LISINC(/2) 272 : NLIGRD=LISDUA(/2) 273 : IF (ITYPEL.EQ.22) NLIGRD=1 274 : SEGINI CORES2 275 : IDEB=1 276 : IF (ITYPEL.EQ.22) IDEB=2 277 : DO 300 ILIGRP=IDEB,NLIGRP 278 : DO ILIGP=1,NLIGP 279 : IF (LISINC(ILIGRP).EQ.LISINP(ILIGP)) THEN 280 : COR2P(ILIGRP)=ILIGP 281 : GOTO 300 282 : ENDIF 283 : ENDDO 284 : COR2P(ILIGRP)=NLIGP+1 285 : 300 CONTINUE 286 : DO 302 ILIGRD=1,NLIGRD 287 : DO ILIGD=1,NLIGD 288 : IF (LISDUA(ILIGRD).EQ.LISIND(ILIGD)) THEN 289 : COR2D(ILIGRD)=ILIGD 290 : GOTO 302 291 : ENDIF 292 : ENDDO 293 : 302 CONTINUE 294 : IPCOR2(I)=CORES2 295 : IF (LDBG) THEN 296 : IF (I.EQ.1.OR.I.EQ.NRIGEL) THEN 297 : WRITE(IOIMP,*) 298 : $ 'Correspondance locale-globale matrice ',imat 299 : $ ,' nrigel=',I 300 : WRITE(IOIMP,*) ' Primales' 301 : WRITE (IOIMP,2019) (LISINC(II),II=1,LISINC(/2)) 302 : WRITE (IOIMP,2020) (COR2P(II),II=1,COR2P(/1)) 303 : WRITE(IOIMP,*) ' Duales' 304 : WRITE (IOIMP,2019) (LISDUA(II),II=1,LISDUA(/2)) 305 : WRITE (IOIMP,2020) (COR2D(II),II=1,COR2D(/1)) 306 : ENDIF 307 : ENDIF 308 : ENDDO 309 : PNTCOB(1,IMAT)=CORES1 310 : ENDDO 311 : * 312 : *_______________________________________________________________________ 313 : * on remplit maintenant le tableau itopts en bouclant sur les sous zones de 314 : * la rigidité 315 : * 316 : NBPTS = XCOOR(/1) / (IDIM +1) 317 : IF (LDBG) WRITE(IOIMP,*) 'NBPTS=',NBPTS 318 : SEGINI MTOPTS 319 : DO IMAT=1,NMAT 320 : CORES1=PNTCOB(1,IMAT) 321 : MRIGID=PNTOB(IMAT) 322 : NRIGEL=IRIGEL(/2) 323 : DO I=1,NRIGEL 324 : MELEME = IRIGEL(1,I) 325 : DESCR = IRIGEL(3,I) 326 : CORES2 = IPCOR2(I) 327 : NLIGRD = NOELED(/1) 328 : IF (ITYPEL.EQ.22) NLIGRD=1 329 : IDEB=1 330 : IF (ITYPEL.EQ.22) IDEB=2 331 : DO K=1,NUM(/2) 332 : DO J=IDEB,NOELEP(/1) 333 : ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT) = 334 : & ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT) 335 : $ + NLIGRD 336 : ENDDO 337 : ENDDO 338 : ENDDO 339 : ENDDO 340 : NTOPTS=0 341 : IF (ICHP.NE.0) THEN 342 : SEGINI NTOPTS 343 : SEGINI OTOPTS 344 : MCHPOI=ICHP 345 : SEGACT MCHPOI 346 : NSOUPO=IPCHP(/1) 347 : DO ISOUPO=1,NSOUPO 348 : MSOUPO=IPCHP(ISOUPO) 349 : SEGACT MSOUPO 350 : MELEME=IGEOC 351 : SEGACT MELEME 352 : MPOVAL=IPOVAL 353 : SEGACT MPOVAL 354 : NC=NOCOMP(/2) 355 : N=NUM(/2) 356 : DO IC=1,NC 357 : DO ILIGP=1,NLIGP 358 : IF (NOCOMP(IC).EQ.LISINP(ILIGP)) THEN 359 : IDK=ILIGP 360 : GOTO 304 361 : ENDIF 362 : ENDDO 363 : IDK=NLIGP+1 364 : 304 CONTINUE 365 : DO 306 I=1,N 366 : IF (VPOCHA(I,IC).NE.0.D0) THEN 367 : LTOPTS(NUM(1,I),IDK)=.TRUE. 368 : XTOPTS(NUM(1,I),IDK)=VPOCHA(I,IC) 369 : ENDIF 370 : 306 CONTINUE 371 : ENDDO 372 : SEGDES MPOVAL,MELEME,MSOUPO 373 : ENDDO 374 : SEGDES MCHPOI 375 : ELSE 376 : SEGINI OTOPTS 377 : DO ILIGP=1,NLIGP 378 : DO IBPTS=1,NBPTS 379 : LTOPTS(IBPTS,ILIGP)=.TRUE. 380 : ENDDO 381 : ENDDO 382 : ENDIF 383 : IF (LDBG) THEN 384 : npo = MIN(nbpts,100) 385 : WRITE(IOIMP,*) 'Point' 386 : WRITE(IOIMP,2020) (II,II=1,npo) 387 : do imat=1,nmat 388 : do iligp=1,nligp 389 : WRITE(IOIMP,*) ' Matrice ',imat,' inconnue ',LISINP(ILIGP 390 : $ ) 391 : WRITE (IOIMP,2020) (ITOPTS(II,iligp,imat),II=1,npo) 392 : enddo 393 : enddo 394 : if (ichp.ne.0) then 395 : do iligp=1,nligp 396 : WRITE(IOIMP,*) ' Chpoint inconnue ',LISINP(ILIGP) 397 : WRITE (IOIMP,2021) (LTOPTS(II,iligp),II=1,npo) 398 : WRITE (IOIMP,2022) (XTOPTS(II,iligp),II=1,npo) 399 : enddo 400 : endif 401 : ENDIF 402 : * 403 : *_______________________________________________________________________ 404 : * 405 : * calcul du nombre d'inconnues primales et creation de LESINC 406 : * correspondance entre les inconnues et MCOEF 407 : * 408 : * 409 : DO IMAT=1,NMAT 410 : DO ILIGP=1,NLIGP 411 : DO IBPTS=1,NBPTS 412 : LTOPTS(IBPTS,ILIGP)=LTOPTS(IBPTS,ILIGP) 413 : $ .AND.(ITOPTS(IBPTS,ILIGP,IMAT).NE.0) 414 : ENDDO 415 : ENDDO 416 : ENDDO 417 : NINC=0 418 : DO ILIGP=1,NLIGP 419 : DO IBPTS=1,NBPTS 420 : IF (LTOPTS(IBPTS,ILIGP)) NINC=NINC+1 421 : ENDDO 422 : ENDDO 423 : IF (LDBG) WRITE(IOIMP,*) 'NINC=',NINC 424 : * On sort de manière anticipée s'il n'y a pas d'inconnues primales 425 : * communes 426 : IF (NINC.EQ.0) THEN 427 : SEGSUP DESCOB,LSINCP,LSINCD 428 : SEGSUP OTOPTS,MTOPTS 429 : DO IMAT=1,NMAT 430 : MRIGID=PNTOB(IMAT) 431 : CORES1=PNTCOB(1,IMAT) 432 : NRIGEL=IRIGEL(/2) 433 : DO I=1,NRIGEL 434 : MELEME = IRIGEL(1,I) 435 : DESCR = IRIGEL(3,I) 436 : SEGDES MELEME,DESCR 437 : CORES2=IPCOR2(I) 438 : SEGSUP CORES2 439 : ENDDO 440 : SEGSUP CORES1 441 : SEGDES MRIGID 442 : ENDDO 443 : IF (NTOPTS.NE.0) SEGSUP NTOPTS 444 : GOTO 9999 445 : ENDIF 446 : * 447 : DO IMAT=1,NMAT 448 : DO ILIGP=1,NLIGP 449 : DO IBPTS=1,NBPTS 450 : IF (.NOT.LTOPTS(IBPTS,ILIGP)) THEN 451 : ITOPTS(IBPTS,ILIGP,IMAT)=0 452 : ELSE 453 : ITOPTS(1,NLIGP+1,IMAT)=ITOPTS(1,NLIGP+1,IMAT) 454 : $ +ITOPTS(IBPTS,ILIGP,IMAT) 455 : ENDIF 456 : ENDDO 457 : ENDDO 458 : ENDDO 459 : SEGSUP OTOPTS 460 : IF (LDBG) THEN 461 : do imat=1,nmat 462 : do iligp=1,nligp 463 : WRITE(IOIMP,*) ' Matrice ',imat,' inconnue ',LISINP(ILIGP 464 : $ ) 465 : WRITE (IOIMP,2020) (ITOPTS(II,iligp,imat),II=1,npo) 466 : enddo 467 : enddo 468 : ENDIF 469 : * 470 : * on remplit LSINCO et LTINCO en numérotant les ddls dans l'ordre 471 : * où ils sont rencontrés en parcourant la matrice la plus grosse. 472 : * On pourrait les parcourir autrement (dans l'ordre de ITOPTS). 473 : * 474 : IF (NMAT.EQ.2) THEN 475 : NCOEF1=ITOPTS(1,NLIGP+1,1) 476 : NCOEF2=ITOPTS(1,NLIGP+1,2) 477 : IF (NCOEF1.GE.NCOEF2) THEN 478 : IMAT1=1 479 : IMAT2=2 480 : ELSE 481 : IMAT1=2 482 : IMAT2=1 483 : ENDIF 484 : ELSE 485 : NCOEF1=ITOPTS(1,NLIGP+1,1) 486 : NCOEF2=0 487 : IMAT1=1 488 : IMAT2=0 489 : ENDIF 490 : IF (LDBG) THEN 491 : WRITE(IOIMP,*) 'NCOEF1=',NCOEF1 492 : WRITE(IOIMP,*) 'NCOEF2=',NCOEF2 493 : ENDIF 494 : MRIGID=PNTOB(IMAT1) 495 : CORES1=PNTCOB(1,IMAT1) 496 : NRIGEL=IRIGEL(/2) 497 : SEGINI LSINCO 498 : IF (ICHP.NE.0) THEN 499 : SEGINI LTINCO 500 : ELSE 501 : LTINCO=0 502 : ENDIF 503 : IND1 = 1 504 : IDUM1 = 1 505 : IDUM2 = 1 506 : DO 1600 I=1,NRIGEL 507 : MELEME=IRIGEL(1,I) 508 : DESCR=IRIGEL(3,I) 509 : IDEB=1 510 : IF (ITYPEL.EQ.22) IDEB=2 511 : CORES2=IPCOR2(I) 512 : DO 1500 K=1,NUM(/2) 513 : DO 1400 J=IDEB,NOELEP(/1) 514 : IF ( ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT1).GT.0) THEN 515 : LESINC(IND1,1,IMAT1)=IDUM1 516 : IDUM1=IDUM1+ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT1) 517 : * ITOPTS va desormais contenir le numéro de l'inconnue dans LESINC 518 : ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT1) = -1 * IND1 519 : IF(NMAT.EQ.2) THEN 520 : LESINC(IND1,1,IMAT2)=IDUM2 521 : IDUM2=IDUM2+ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT2) 522 : ENDIF 523 : IF (ICHP.NE.0) THEN 524 : XMAS(IND1) = XTOPTS(NUM(NOELEP(J),K),COR2P(J)) 525 : ENDIF 526 : IND1 = IND1 + 1 527 : ENDIF 528 : 1400 CONTINUE 529 : 1500 CONTINUE 530 : 1600 CONTINUE 531 : *===== 532 : if ( (IND1-1) .NE. NINC ) then 533 : write(*,*) 'erreur dans boucle lsinco' 534 : endif 535 : *====== 536 : LESINC(IND1,1,IMAT1)=IDUM1 537 : IF (NMAT.EQ.2) LESINC(IND1,1,IMAT2)=IDUM2 538 : IF (LDBG) THEN 539 : WRITE(IOIMP,*) 'IDUM1=',IDUM1 540 : WRITE(IOIMP,*) 'IDUM2=',IDUM2 541 : naff=min(ninc,100) 542 : do 2004 k=1,nmat 543 : write(*,*) 'k=',k 544 : do 2002 i=1,naff+1 545 : write(*,2003) i,lesinc(i,1,k),lesinc(i,2,k) 546 : 2002 continue 547 : 2004 continue 548 : ENDIF 549 : * 550 : *_______________________________________________________________________ 551 : * remplissage de MCOEF 552 : * 553 : * 554 : DO IMAT=1,NMAT 555 : MRIGID=PNTOB(IMAT) 556 : CORES1=PNTCOB(1,IMAT) 557 : NRIGEL=IRIGEL(/2) 558 : NCOEF=LESINC(NINC+1,1,IMAT)-1 559 : SEGINI MCOEF 560 : DO 1900 I=1,NRIGEL 561 : MELEME = IRIGEL(1,I) 562 : DESCR = IRIGEL(3,I) 563 : CORES2 = IPCOR2(I) 564 : XMATRI = IRIGEL(4,I) 565 : SEGACT XMATRI 566 : IDEB=1 567 : IF (ITYPEL.EQ.22) IDEB=2 568 : NLIGRD=NOELED(/1) 569 : IF (ITYPEL.EQ.22) NLIGRD=1 570 : DO 1800 K=1,NUM(/2) 571 : DO 1700 J=IDEB,NOELEP(/1) 572 : NNINC = -1 * ITOPTS(NUM(NOELEP(J),K),COR2P(J),IMAT1) 573 : IF (NNINC.NE.0) THEN 574 : DO 1650 L=1,NLIGRD 575 : IDMCOE = LESINC(NNINC,1,IMAT) 576 : $ +LESINC(NNINC,2,IMAT) 577 : LESINC(NNINC,2,IMAT) = LESINC(NNINC,2,IMAT) + 1 578 : ICOEF(1,IDMCOE)=NUM(NOELED(L),K) 579 : ICOEF(2,IDMCOE)=COR2D(L) 580 : XCOEF(IDMCOE)=RE(L,J,k)*COERIG(I) 581 : 1650 CONTINUE 582 : ENDIF 583 : 1700 CONTINUE 584 : 1800 CONTINUE 585 : * on referme la boutique 586 : SEGDES XMATRI 587 : SEGSUP CORES2 588 : 1900 CONTINUE 589 : * on referme encore la boutique car meleme et descr 590 : * peuvent être les mêmes pour plusieurs IRIGEL 591 : DO 2000 I=1,NRIGEL 592 : MELEME = IRIGEL(1,I) 593 : DESCR = IRIGEL(3,I) 594 : SEGDES MELEME,DESCR 595 : 2000 CONTINUE 596 : SEGSUP CORES1 597 : SEGDES MRIGID 598 : * 599 : *===== 600 : IF (LDBG) THEN 601 : naff = min(ncoef,100) 602 : do 2005 i=1,naff 603 : write(*,2003) i,icoef(1,i),icoef(2,i),xcoef(i) 604 : 2005 continue 605 : ENDIF 606 : *===== 607 : PNTCOB(3,IMAT)=MCOEF 608 : ENDDO 609 : SEGSUP MTOPTS 610 : *------------------------ 611 : * Il faut maintenant compacter le MCOEF car le même ddl dual peut 612 : * apparaître plusieurs fois pour une même inconnue primale (ce n'était 613 : * pas le cas anciennement car les ddls duaux étaient des multiplicateurs 614 : * de lagrange supposés uniques (un par relation)) 615 : * 616 : IF (LTYP22) GOTO 755 617 : DO IMAT=1,NMAT 618 : MCOEF=PNTCOB(3,IMAT) 619 : DO IINC=1,NINC 620 : IDEB=LESINC(IINC,1,IMAT) 621 : IFIN=IDEB+LESINC(IINC,2,IMAT)-1 622 : DO I=IDEB,IFIN 623 : IC1=ICOEF(1,I) 624 : IC2=ICOEF(2,I) 625 : IF (IC1.NE.0) THEN 626 : DO J=I+1,IFIN 627 : JC1=ICOEF(1,J) 628 : JC2=ICOEF(2,J) 629 : IF (JC1.EQ.IC1.AND.JC2.EQ.IC2) THEN 630 : XCOEF(I)=XCOEF(I)+XCOEF(J) 631 : ICOEF(1,J)=0 632 : ENDIF 633 : ENDDO 634 : ENDIF 635 : ENDDO 636 : ENDDO 637 : *===== 638 : IF (LDBG) THEN 639 : WRITE(IOIMP,*) 'COMPACTAGE 1' 640 : naff = min(ncoef,100) 641 : do i=1,naff 642 : write(*,2003) i,icoef(1,i),icoef(2,i),xcoef(i) 643 : enddo 644 : ENDIF 645 : *===== 646 : IDECG=0 647 : IDEB=LESINC(1,1,IMAT) 648 : DO IINC=1,NINC 649 : IFIN=IDEB+LESINC(IINC,2,IMAT)-1 650 : IDECL=0 651 : DO I=IDEB,IFIN 652 : IF (ICOEF(1,I).EQ.0) THEN 653 : IDECL=IDECL+1 654 : ELSE 655 : ICOEF(1,I-IDECG-IDECL)=ICOEF(1,I) 656 : ICOEF(2,I-IDECG-IDECL)=ICOEF(2,I) 657 : XCOEF(I-IDECG-IDECL)=XCOEF(I) 658 : ENDIF 659 : ENDDO 660 : LESINC(IINC,2,IMAT)=LESINC(IINC,2,IMAT)-IDECL 661 : IDEB=LESINC(IINC+1,1,IMAT) 662 : IDECG=IDECG+IDECL 663 : LESINC(IINC+1,1,IMAT)=LESINC(IINC+1,1,IMAT)-IDECG 664 : ENDDO 665 : NCOEF=LESINC(NINC+1,1,IMAT)-1 666 : SEGADJ MCOEF 667 : IF (LDBG) THEN 668 : WRITE(IOIMP,*) 'NCOEF=',NCOEF 669 : WRITE(IOIMP,*) 'COMPACTAGE 2' 670 : naff=min(ninc,100) 671 : do i=1,naff+1 672 : k=imat 673 : write(*,2003) i,lesinc(i,1,k),lesinc(i,2,k) 674 : enddo 675 : naff = min(ncoef,100) 676 : do i=1,naff 677 : write(*,2003) i,icoef(1,i),icoef(2,i),xcoef(i) 678 : enddo 679 : ENDIF 680 : ENDDO 681 : 755 CONTINUE 682 : *_______________________________________________________________________ 683 : * 684 : * il ne reste plus qu' a creer les matrices élémentaires 685 : * 686 : NOER = .TRUE. 687 : * Construction des noms d'inconnues primales correspondant à LISIND 688 : NLIGD=LISIND(/2) 689 : SEGINI CORIDP 690 : DO ILIGD=1,NLIGD 690 : CALL PLACE(NOMDU,LNOMDU,idx,LISIND(ILIGD)) 691 : IF (idx.EQ.0) THEN 692 : LISIDP(ILIGD)=LISIND(ILIGD) 693 : ELSE 694 : LISIDP(ILIGD)=NOMDD(idx) 695 : ENDIF 696 : ENDDO 697 : * 698 : * il y a autant de matrices élémentaires qu'il y a de coefficients 699 : * 700 : NRIGEL=NINC 701 : SEGINI MRIGID 702 : IRIG2 = MRIGID 703 : MTYMAT='CMCT ' 704 : * 705 : * boucle sur les sous zones 706 : * 707 : DO 700 I=1,NRIGEL 708 : * GRXDUM = 0.D0 709 : * PTXDUM = 9.D50 710 : COERIG(I) = 1.D0 711 : NBNN=0 712 : IDXDUA=0 713 : * 714 : * S'il y a deux rigidités à multiplier, on stocke la primale 715 : * puis la duale dans le MELEME et dans XDUM. A ce moment-là, 716 : * IDXDUA+1 est l'index de départ des noeuds et des valeurs de la duale. 717 : * On parcourt donc DESCOB à l'envers car on avait d'abord mis 718 : * la duale C avant la primale B 719 : * 720 : DO IMAT=NMAT,1,-1 721 : NBNN=NBNN+LESINC(I,2,IMAT) 722 : IF (IDXDUA.EQ.0.AND.NMAT.EQ.2) IDXDUA=NBNN 723 : ENDDO 724 : * creation du maillage et du vecteur des coefficients 725 : NBELEM = 1 726 : NBSOUS = 0 727 : NBREF = 0 728 : SEGINI WORK1 729 : SEGINI MELEME 730 : INOEU = 0 731 : DO IMAT=NMAT,1,-1 732 : MCOEF=PNTCOB(3,IMAT) 733 : DO 1200 J=0,LESINC(I,2,IMAT)-1 734 : INOEU = INOEU + 1 735 : NUM(INOEU,1) = ICOEF(1,J+LESINC(I,1,IMAT)) 736 : XDUM(INOEU) = XCOEF(J+LESINC(I,1,IMAT)) 737 : * GRXDUM=MAX(GRXDUM,ABS(XDUM(INOEU))) 738 : * IF (XDUM(INOEU).NE.0.D0) THEN 739 : * PTXDUM=MIN(PTXDUM,ABS(XDUM(INOEU))) 740 : * ENDIF 741 : 1200 CONTINUE 742 : * 743 : * petit controle sur le conditionnement de la matrice 744 : * il n'est pas forcément pertinent 745 : * 746 : * IF (((PTXDUM/GRXDUM).LT.1.D-12).AND.NOER) THEN 746 : * CALL ERREUR(-320) 747 : * NOER = .FALSE. 748 : * ENDIF 749 : ENDDO 750 : ITYPEL = 28 751 : IRIGEL(1,I) = MELEME 752 : * 753 : * segment descripteur DESCR 754 : * 755 : NLIGRP=NBNN 756 : IF (NMAT.EQ.1) THEN 757 : NLIGRP = NBNN 758 : NLIGRD = NBNN 759 : ELSE 760 : NLIGRP = IDXDUA 761 : NLIGRD = NBNN-IDXDUA 762 : ENDIF 763 : SEGINI DESCR 764 : IPASS=0 765 : DO IMAT=NMAT,1,-1 766 : MCOEF=PNTCOB(3,IMAT) 767 : IPASS=IPASS+1 768 : INOEU=0 769 : DO 1300 J=0,LESINC(I,2,IMAT)-1 770 : INOEU = INOEU + 1 771 : IF (IPASS.EQ.1) THEN 772 : LISINC(INOEU) = LISIDP(ICOEF(2,J+LESINC(I,1,IMAT))) 773 : NOELEP(INOEU)=INOEU 774 : IF (NMAT.EQ.1) THEN 775 : LISDUA(INOEU) = LISIND(ICOEF(2,J+LESINC(I,1,IMAT))) 776 : NOELED(INOEU)=INOEU 777 : ENDIF 778 : ENDIF 779 : IF (IPASS.EQ.2) THEN 780 : LISDUA(INOEU) 781 : $ = LISIND(ICOEF(2,J+LESINC(I,1,IMAT))) 782 : NOELED(INOEU)=IDXDUA+INOEU 783 : ENDIF 784 : 1300 CONTINUE 785 : ENDDO 786 : IRIGEL(3,I) = DESCR 787 : * 788 : * la matrice elle meme 789 : * 790 : IF (ICHP.NE.0) THEN 791 : XCOEF=XMAS(I) 792 : ELSE 793 : XCOEF=1.D0 794 : ENDIF 795 : NELRIG = 1 796 : SEGINI XMATRI 797 : IRIGEL(4,I)=XMATRI 798 : DO 600 J=1,NLIGRP 799 : DO 500 K=1,NLIGRD 800 : RE(K,J,1)=XDUM(IDXDUA+K)*XDUM(J)*XCOEF 801 : 500 CONTINUE 802 : 600 CONTINUE 803 : SEGDES XMATRI 804 : * 805 : SEGDES DESCR 806 : SEGSUP WORK1 807 : SEGDES MELEME 808 : * S'il y a deux matrices en entrée, le résultat 809 : * n'est sans doute pas symétrique 810 : IF (NMAT.EQ.2) IRIGEL(7,I)=2 811 : 700 CONTINUE 812 : SEGDES MRIGID 813 : * 814 : * Ménage 815 : * 816 : 817 : DO IMAT=1,NMAT 818 : MCOEF=PNTCOB(3,IMAT) 819 : SEGSUP MCOEF 820 : ENDDO 821 : SEGSUP LSINCO 822 : IF (LTINCO.NE.0) SEGSUP LTINCO 823 : SEGSUP CORIDP 824 : SEGSUP LSINCP 825 : RETURN 826 : * 827 : * Rigidité vide si pas de ddls primaux communs entre les 828 : * objets d'entrée 829 : * 830 : 9999 CONTINUE 831 : NRIGEL=0 832 : SEGINI MRIGID 833 : MTYMAT='CMCT ' 834 : SEGDES MRIGID 835 : IRIG2=MRIGID 836 : * 837 : 2003 format(I4,1X,I4,1X,I4,2X,E12.5) 838 : 2019 FORMAT (20(2X,A4) ) 839 : 2020 FORMAT (20(2X,I4) ) 840 : 2021 FORMAT (20(2X,L4) ) 841 : 2022 FORMAT(10(1X,1PG12.5)) 842 : *_______________________________________________________________________ 843 : RETURN 844 : END 845 : 846 : 847 : 848 : 849 : 850 : 851 : 852 : 853 : 854 : 855 : 856 :
© Cast3M 2003 - All rights reserved.
Disclaimer