1 : C SCND2 SOURCE PV 11/11/25 21:15:00 7191 2 : * 3 : subroutine scnd2(mrigid,ri1,ri4) 4 : * 5 : * entree 6 : * mrigid rigidité sans sous matrices de dependances 7 : * ri1 rigidite de dependance 8 : * 9 : * sortie 10 : * ri4 rigidite condensee les noeuds dependants sont 11 : * elimines 12 : * 13 : * on suppose que la premiere inconnue de la raideur de dependance 14 : * (celle qu'on elimine) n'apparait que dans cette dependance 15 : * Cela va permettre de constituer les tableau : 16 :
Warning: preg_replace(): Compilation failed: missing ) at offset 8 in C:\xampp\htdocs\cast3m_kit_local_fr_en_2014\sources.php on line 158
17 : * au moment de la création des matrices, on va s'efforcer de factoriser 18 : * les descripteurs 19 : * 20 : IMPLICIT INTEGER(I-N) 21 : IMPLICIT REAL*8 (A-H,O-Z) 22 : * 23 : -INC SMRIGID 24 : -INC SMELEME 25 : -INC CCOPTIO 26 : -INC SMCOORD 27 : -INC CCHAMP 28 : segment trav1 29 : character*4 compd(nbincd),compdd(nbincd) 30 : endsegment 31 : segment trav2 32 : integer irigd(nbno,nbincd),nelrigd(nbno,nbincd) 33 : endsegment 34 : segment trav3 35 : integer cor1p(nligrp),cor1d(nligrd) 36 : endsegment 37 : segment imatno(lmatno) 38 : segment idesno(ldesno) 39 : segment igeomno(lgeomno) 40 : segment coerno(lcoerno) 41 : segment irg7no(lrg7no) 42 : segment irg6no(lrg6no) 43 : segment irg5no(lrg5no) 44 : segment irg2no(lrg2no) 45 : segment imatt(nelrig) 46 : logical dupli,descar 47 : character*4 co1,co1d 48 : segment svu 49 : logical vu(lvu) 50 : endsegment 51 : * 52 : * write (6,*) ' raideur initiale ' 52 : * call prrigi(mrigid,0) 53 : * write (6,*) ' raideur dependance ' 53 : * call prrigi(ri1,1) 54 : 55 : lvu=0 56 : lmatno=1000 57 : ldesno=1000 58 : lgeomno=1000 59 : lcoerno=1000 60 : lrg7no=1000 61 : lrg6no=1000 62 : lrg5no=1000 63 : lrg2no=1000 64 : kmatno=0 65 : kdesno=0 66 : kgeomno=0 67 : kcoerno=0 68 : krg7no=0 69 : krg6no=0 70 : krg5no=0 71 : krg2no=0 72 : segini imatno,idesno,igeomno,coerno,irg7no,irg5no,svu 73 : segini irg2no,irg6no 74 : * remplissage du segment trav1 (liste des noms de composantes) 75 : nbincd=0 76 : segini trav1 77 : nbno=xcoor(/1)/(idim+1) 78 : segact ri1 79 : do 10 irig=1,ri1.irigel(/2) 80 : descr=ri1.irigel(3,irig) 81 : segact descr 82 : do 40 nligrd=1,lisdua(/2) 83 : do 50 inc=1,nbincd 84 : if (compd(inc).eq.lisdua(nligrd)) goto 40 85 : 50 continue 86 : nbincd=nbincd+1 87 : segadj trav1 88 : compd(nbincd)=lisdua(nligrd) 89 : 40 continue 90 : do 45 nligrd=1,lisinc(/2) 91 : do 55 inc=1,nbincd 92 : if (compd(inc).eq.lisinc(nligrd)) goto 45 93 : 55 continue 94 : nbincd=nbincd+1 95 : segadj trav1 96 : compd(nbincd)=lisinc(nligrd) 97 : 45 continue 98 : 10 continue 99 : * write (6,*) ' scnd2 - 1 ',(compd(i),i=1,nbincd) 100 : segact mrigid 101 : do 110 irig=1,irigel(/2) 102 : descr=irigel(3,irig) 103 : segact descr 104 : do 140 nligrd=1,lisinc(/2) 105 : do 150 inc=1,nbincd 106 : if (compd(inc).eq.lisinc(nligrd)) goto 140 107 : 150 continue 108 : nbincd=nbincd+1 109 : segadj trav1 110 : compd(nbincd)=lisinc(nligrd) 111 : 140 continue 112 : 110 continue 113 : * write (6,*) ' scnd2 - 2 ',(compd(i),i=1,nbincd) 114 : * au tour de trav2 (inconnue => raideur de dépendance) 115 : segini trav2 116 : do 200 irig=1,ri1.irigel(/2) 117 : meleme=ri1.irigel(1,irig) 118 : descr=ri1.irigel(3,irig) 119 : xmatri=ri1.irigel(4,irig) 120 : segact meleme,descr,xmatri 121 : do 250 incd=1,nbincd 122 : if (compd(incd).eq.lisdua(1)) goto 260 123 : 250 continue 123 : call erreur(5) 124 : 260 continue 125 : do 240 i=1,num(/2) 126 : ip=num(noeled(1),i) 127 : irigd(ip,incd)=irig 128 : nelrigd(ip,incd)=i 129 : 240 continue 130 : 200 continue 131 : * rechercher les noms d'inconnues duales 132 : do 300 i=1,compd(/2) 133 : do 310 j=1,lnomdd 134 : * write (6,*) ' i j compd nomdd ',i,j,compd(i),nomdd(j) 135 : if (compd(i).eq.nomdd(j)) goto 320 136 : 310 continue 137 : * write (6,*) ' pas de nom dual trouvé ' 138 : compdd(i)=compd(i) 139 : goto 300 140 : 320 continue 141 : compdd(i)=nomdu(j) 142 : * write (6,*) ' correspondance ', compd(i), compdd(i) 143 : 300 continue 144 : * write (6,*) ' scnd2 - 3 ',(compdd(i),i=1,compdd(/2)) 145 : * 146 : * maintenant, on balaye les raideurs. Pour chacune d'entre elle, on 147 : * balaye les inconnues pour trouver une dépendance. Si oui on construit 148 : * le résultat de l'opération 149 : segini,ri4=mrigid 150 : ri4.ichole=0 151 : ri4.imgeo1=0 152 : ri4.imgeo2=0 153 : ri4.isupeq=0 154 : * boucle raideur en cours de condensation 155 : do 1000 irig=1,ri4.irigel(/2) 156 : * write(ioimp,*) 'Balayage raideur ',irig 157 : meleme=ri4.irigel(1,irig) 158 : segini,ipt4=meleme 159 : segdes meleme 160 : ri4.irigel(1,irig)=ipt4 161 : des4=ri4.irigel(3,irig) 162 : Xmatri=ri4.irigel(4,irig) 163 : segini,Xmatr4=Xmatri 164 : nelrig=xmatr4.re(/3) 165 : segini imatt 166 : segdes Xmatri 167 : ri4.irigel(4,irig)=Xmatr4 168 : * On regarde le descripteur. S'il est symétrique, on pourra 169 : * faire le travail en une passe sinon deux. 170 : * Correspondance lisinc, lisdua, numéro incd dans trav1 171 : nligrp=des4.lisinc(/2) 172 : nligrd=des4.lisdua(/2) 173 : segini trav3 174 : do 410 iligrp=1,nligrp 175 : do 420 incd=1,nbincd 176 : if (compd(incd).eq.des4.lisinc(iligrp)) then 177 : cor1p(iligrp)=incd 178 : goto 410 179 : endif 180 : 420 continue 181 : 410 continue 182 : do 510 iligrd=1,nligrd 183 : do 520 incd=1,nbincd 184 : if (compdd(incd).eq.des4.lisdua(iligrd)) then 185 : cor1d(iligrd)=incd 186 : goto 510 187 : endif 188 : 520 continue 189 : 510 continue 190 : * write(ioimp,*) 'nligrp=',nligrp 191 : * write(ioimp,*) 'nligrd=',nligrd 192 : descar=.false. 193 : if (nligrp.ne.nligrd) goto 600 194 : do iligr=1,nligrp 195 : if (cor1p(iligr).ne.cor1d(iligr)) goto 600 196 : if (des4.noelep(iligr).ne.des4.noeled(iligr)) goto 600 197 : enddo 198 : descar=.true. 199 : 600 continue 200 : * WRITE(IOIMP,194)(des4.NOELEP(J),des4.LISINC(J),cor1p(j),J=1 201 : * $ ,nligrp) 202 : * WRITE(IOIMP,194)(des4.NOELED(J),des4.LISDUA(J),cor1d(j),J=1 203 : * $ ,nligrd) 204 : * 194 FORMAT( I6,9X,A4,9X,I6) 205 : * if (descar) then 206 : * write(ioimp,*) 'le descripteur est carre' 207 : * else 208 : * write(ioimp,*) 'le descripteur n''est pas carre' 209 : * endif 210 : npass=2 211 : if (descar) npass=1 212 : do 1040 i=1,ipt4.num(/2) 213 : dupli=.false. 214 : * On fait deux passes : une pour la primale et une pour la duale 215 : * sauf si le descripteur est carré 216 : do 1045 ipass=1,npass 217 : if (ipass.eq.1) then 218 : nligr4=des4.lisinc(/2) 219 : else 220 : nligr4=des4.lisdua(/2) 221 : endif 222 : do 1010 nligri=1,nligr4 223 : if (ipass.eq.1) then 224 : incd=cor1p(nligri) 225 : else 226 : incd=cor1d(nligri) 227 : endif 228 : if (incd.eq.0) goto 1010 229 : if (ipass.eq.1) then 230 : ip=ipt4.num(des4.noelep(nligri),i) 231 : else 232 : ip=ipt4.num(des4.noeled(nligri),i) 233 : endif 234 : * y a t'il une dependance concernant ce noeud 235 : if (nelrigd(ip,incd).eq.0) goto 1010 236 : * ici il faut eliminer l'inconnue 237 : * on commence par dupliquer la la matrice si ce n'est pas deja fait 238 : if (.not.dupli) then 239 : ird=irigel(/1) 240 : krg7no=krg7no+1 241 : if (krg7no.gt.irg7no(/1)) then 242 : lrg7no=irg7no(/1)+1000 243 : segadj irg7no 244 : endif 245 : if (ird.ge.7) then 246 : irg7no(krg7no)=ri4.irigel(7,irig) 247 : else 248 : irg7no(krg7no)=0 249 : endif 250 : krg6no=krg6no+1 251 : if (krg6no.gt.irg6no(/1)) then 252 : lrg6no=irg6no(/1)+1000 253 : segadj irg6no 254 : endif 255 : if (ird.ge.6) then 256 : irg6no(krg6no)=ri4.irigel(6,irig) 257 : else 258 : irg6no(krg6no)=0 259 : endif 260 : krg5no=krg5no+1 261 : if (krg5no.gt.irg5no(/1)) then 262 : lrg5no=irg5no(/1)+1000 263 : segadj irg5no 264 : endif 265 : if (ird.ge.5) then 266 : irg5no(krg5no)=ri4.irigel(5,irig) 267 : else 268 : irg5no(krg5no)=0 269 : endif 270 : krg2no=krg2no+1 271 : if (krg2no.gt.irg2no(/1)) then 272 : lrg2no=irg2no(/1)+1000 273 : segadj irg2no 274 : endif 275 : irg2no(krg2no)=ri4.irigel(2,irig) 276 : segini,descr=des4 277 : kdesno=kdesno+1 278 : if (kdesno.gt.idesno(/1)) then 279 : ldesno=idesno(/1)+1000 280 : segadj idesno 281 : endif 282 : idesno(kdesno)=descr 283 : nbnn=ipt4.num(/1) 284 : nbelem=1 285 : nbref=0 286 : nbsous=0 287 : segini meleme 288 : itypel=28 289 : * si c'est une matrice de relation, il faut garder l'attribut 290 : if (ipt4.itypel.eq.22) itypel=22 291 : do i1=1,nbnn 292 : num(i1,1)=ipt4.num(i1,i) 293 : enddo 294 : kgeomno=kgeomno+1 295 : if (kgeomno.gt.igeomno(/1)) then 296 : lgeomno=igeomno(/1)+1000 297 : segadj igeomno 298 : endif 299 : igeomno(kgeomno)=meleme 300 : * xmatr4=imatr4.imattt(i) 301 : * segini,xmatri=xmatr4 302 : nligrp=xmatr4.re(/2) 303 : nligrd=xmatr4.re(/1) 304 : nelrig=1 305 : segini xmatri 306 : do io=1,nligrp 307 : do iu=1,nligrd 308 : re(iu,io,1)=xmatr4.re(iu,io,i) 309 : enddo 310 : enddo 311 : kmatno=kmatno+1 312 : if (kmatno.gt.imatno(/1))then 313 : lmatno=imatno(/1)+1000 314 : segadj imatno 315 : endif 316 : imatno(kmatno)=xmatri 317 : kcoerno=kcoerno+1 318 : if (kcoerno.gt.coerno(/1))then 319 : lcoerno=coerno(/1)+1000 320 : segadj coerno 321 : endif 322 : coerno(kcoerno)=ri4.coerig(irig) 323 : dupli=.true. 324 : * imatr4.imattt(i)=0 325 : imatt(i)=1 326 : endif 327 : * on elimine dans la matrice dupliquee 328 : irig1=irigd(ip,incd) 329 : i1=nelrigd(ip,incd) 330 : ipt1=ri1.irigel(1,irig1) 331 : des1=ri1.irigel(3,irig1) 332 : xmatr1=ri1.irigel(4,irig1) 333 : segact ipt1,des1,xmatr1 334 : * nligrd1 =des1.lisdua(/2) 335 : * nligrd1=1 est l'inconnue à éliminer (de la matrice de dependance) 336 : nligrd1=1 337 : nligrp1=des1.lisinc(/2) 338 : * write (6,*) ' scnd2 nligrp1 nligrd1 i1 ',nligrp1,nligrd1,i1, 339 : * > ip,incp 340 : * nlig1 : inconnue primale à remettre dans la matrice (comme primale) 341 : do 1050 nlig1=1,nligrp1 342 : ip1=ipt1.num(des1.noelep(nlig1),i1) 343 : co1=des1.lisinc(nlig1) 344 : if (ipass.eq.2.or.descar) then 345 : do incd=1,nbincd 346 : if (compd(incd).eq.co1) then 347 : co1d=compdd(incd) 348 : goto 1055 349 : endif 350 : enddo 351 : write (6,*) ' scnd2 2 pas de correspondance ' 352 : $ ,co1 352 : call erreur(5) 353 : return 354 : 1055 continue 355 : endif 356 : * write (6,*) ' ip1 co1 nligrpi ',ip1,co1,nligrpi 357 : * le ddl est il deja dans la raideur 358 : nbno=0 359 : if (ipass.eq.1) then 360 : do 1060 nligr=1,lisinc(/2) 361 : if (noelep(nligr).eq.0) goto 1060 362 : if (num(noelep(nligr),1).ne.ip1) goto 1060 363 : * on note le numéro local du noeud pour le reutiliser 364 : nbno=noelep(nligr) 365 : if (lisinc(nligr).ne.co1) goto 1060 366 : goto 1070 367 : 1060 continue 368 : else 369 : do 2060 nligr=1,lisdua(/2) 370 : if (noeled(nligr).eq.0) goto 2060 371 : if (num(noeled(nligr),1).ne.ip1) goto 2060 372 : * on note le numéro local du noeud pour le reutiliser 373 : nbno=noeled(nligr) 374 : if (lisdua(nligr).ne.co1d) goto 2060 375 : goto 1070 376 : 2060 continue 377 : endif 378 : * on n'a pas trouve le ddl, on le rajoute 379 : * write (6,*) ' ajout de ddl' 380 : if (descar) then 381 : nligr =lisinc(/2)+1 382 : nligrp=lisinc(/2)+1 383 : nligrd=lisdua(/2)+1 384 : else 385 : if (ipass.eq.1) then 386 : nligr =lisinc(/2)+1 387 : nligrp=lisinc(/2)+1 388 : nligrd=lisdua(/2) 389 : else 390 : nligr =lisdua(/2)+1 391 : nligrp=lisinc(/2) 392 : nligrd=lisdua(/2)+1 393 : endif 394 : endif 395 : segadj descr 396 : segadj xmatri 397 : if (nbno.eq.0) then 398 : nbsous=0 399 : nbelem=1 400 : nbnn=num(/1)+1 401 : nbref=0 402 : segadj meleme 403 : nbno=nbnn 404 : endif 405 : num(nbno,1)=ip1 406 : if (ipass.eq.1) then 407 : noelep(nligrp)=nbno 408 : lisinc(nligrp)=co1 409 : endif 410 : if (ipass.eq.2.or.descar) then 411 : lisdua(nligrd)=co1d 412 : noeled(nligrd)=nbno 413 : endif 414 : 1070 continue 415 : * on met a jour la raideur 416 : nligrp=lisinc(/2) 417 : nligrd=lisdua(/2) 418 : * xmatr1=imatr1.imattt(i1) 419 : * segact xmatr1 420 : if (ipass.eq.2.or.descar) then 421 : do j=1,nligrp 422 : re(nligr,j,1)=re(nligr,j,1)+re(nligri,j,1) 423 : $ *xmatr1.re(1,nlig1,i1) 424 : enddo 425 : endif 426 : if (ipass.eq.1) then 427 : do j=1,nligrd 428 : re(j,nligr,1)=re(j,nligr,1)+re(j,nligri,1) 429 : $ *xmatr1.re(1,nlig1,i1) 430 : enddo 431 : if (ipt4.itypel.eq.22) then 432 : do ii=3,nligrp 433 : if (abs(re(1,ii,1)).gt.1d10) goto 1051 434 : enddo 435 : * write (6,*) ' scnd2 relation trop petite ' 436 : * write (6,*) 'scnd2 ',(re(1,ii),ii=1,nligrp) 437 : * write (6,*) 'scnd2 ',(lisinc(ii),ii=1,nligrp) 438 : 1051 continue 439 : endif 440 : endif 441 : * segdes xmatr1 442 : 1050 continue 443 : * on note les inconnues à supprimer (primale et duale) 444 : * write (6,*) ' il faut eliminer ',nligrpi,lisinc(nligrpi) 445 : * write (6,*) ' lisinc contient ',(lisinc(iou),iou=1,lisinc(/2)) 446 : if (ipass.eq.1) noelep(nligri)=0 447 : if (ipass.eq.2.or.descar) noeled(nligri)=0 448 : 1010 continue 449 : * 450 : * write(ioimp,*) 'Avant suppression des inconnues flaguees' 451 : * WRITE(IOIMP,194)(NOELEP(J),LISINC(J),J=1,LISINC(/2)) 452 : * WRITE(IOIMP,194)(NOELED(J),LISDUA(J),J=1,LISDUA(/2)) 453 : * 194 FORMAT( I6,9X,A4) 454 : * WRITE(IOIMP,195) ((RE(L,K,1),K=1,RE(/2)),L=1,RE(/1)) 455 : * 195 FORMAT(1X,6E12.5) 456 : * on supprime les inconnues flaguées 457 : 1045 continue 458 : if (dupli) then 459 : idecp=0 460 : do 1080 nligr=1,lisinc(/2) 461 : if (noelep(nligr).eq.0) then 462 : idecp=idecp+1 463 : else 464 : lisinc(nligr-idecp)=lisinc(nligr) 465 : noelep(nligr-idecp)=noelep(nligr) 466 : do nligd=1,lisdua(/2) 467 : * re(nligr-idecp,nligd,1)=re(nligr,nligd,1) 468 : re(nligd,nligr-idecp,1)=re(nligd,nligr,1) 469 : enddo 470 : endif 471 : 1080 continue 472 : idecd=0 473 : do 1090 nligd=1,lisdua(/2) 474 : if (noeled(nligd).eq.0) then 475 : idecd=idecd+1 476 : else 477 : lisdua(nligd-idecd)=lisdua(nligd) 478 : noeled(nligd-idecd)=noeled(nligd) 479 : do nligr=1,lisinc(/2) 480 : * re(nligr,nligd-idecd,1)=re(nligr,nligd,1) 481 : re(nligd-idecd,nligr,1)=re(nligd,nligr,1) 482 : enddo 483 : endif 484 : 1090 continue 485 : nligrp=lisinc(/2)-idecp 486 : nligrd=lisdua(/2)-idecd 487 : * on supprime les matrices ne contenant que les multiplicateurs de Lagrange 488 : * ou les autres termes non significatifs 489 : if (itypel.eq.22) then 490 : *** write (6,*) (lisinc(iou),iou=1,lisinc(/2)) 491 : if (nligrd.eq.1) then 492 : * write (6,*) ' scnd2 matrice supprimee 1 LX' 493 : nligrd=0 494 : nligrp=0 495 : endif 496 : if (nligrd.eq.2.and.lisinc(2).eq.'LX') then 497 : * write (6,*) ' scnd2 matrice supprimee 2 LX' 498 : nligrd=0 499 : nligrp=0 500 : endif 501 : iid=2 502 : if (nligrd.ge.2.and.lisinc(2).eq.'LX') iid=3 503 : do ii=iid,nligrd 504 : if (abs(re(1,ii)).gt.1D-6) goto 1091 505 : enddo 506 : * write (6,*) ' scnd2 matrice supprimee LX ',iid-1 507 : nligrd=0 508 : nligrp=0 509 : 1091 continue 510 : endif 511 : segadj xmatri 512 : segdes xmatri 513 : segadj descr 514 : * la matrice est fabriquée, on elimine maintenant les noeuds 515 : * non references 516 : lvu=num(/1) 517 : segadj svu 518 : do in=1,vu(/1) 519 : vu(in)=.false. 520 : enddo 521 : do in=1,noelep(/1) 522 : vu(noelep(in))=.true. 523 : enddo 524 : if (.not.descar) then 525 : do in=1,noeled(/1) 526 : vu(noeled(in))=.true. 527 : enddo 528 : endif 529 : idec=0 530 : do 1095 in=1,num(/1) 531 : if (.not.vu(in)) then 532 : * noeud a eliminer 533 : idec=idec+1 534 : else 535 : do no=1,noelep(/1) 536 : if (noelep(no).eq.in) then 537 : noelep(no)=noelep(no)-idec 538 : if (descar) noeled(no)=noeled(no)-idec 539 : endif 540 : enddo 541 : if (.not.descar) then 542 : do no=1,noeled(/1) 543 : if (noeled(no).eq.in) then 544 : noeled(no)=noeled(no)-idec 545 : endif 546 : enddo 547 : endif 548 : num(in-idec,1)=num(in,1) 549 : endif 550 : 1095 continue 551 : nbnn=num(/1)-idec 552 : nbelem=1 553 : nbsous=0 554 : nbref=0 555 : segadj meleme 556 : if (nbnn.eq.0) imatno(kmatno)=0 557 : endif 558 : 1040 continue 559 : * compression de ipt4 et imatr4 560 : idec=0 561 : * do 2000 i=1,imatr4.imattt(/1) 562 : do 2000 i=1,xmatr4.re(/3) 563 : * if (imatr4.imattt(i).eq.0) then 564 : if(imatt(i).ne.0) then 565 : idec=idec+1 566 : else 567 : do io=1,xmatr4.re(/2) 568 : do iu=1,xmatr4.re(/1) 569 : xmatr4.re(iu,io,i-idec)=xmatr4.re(iu,io,i) 570 : enddo 571 : enddo 572 : * imatr4.imattt(i-idec)=imatr4.imattt(i) 573 : do in=1,ipt4.num(/1) 574 : ipt4.num(in,i-idec)=ipt4.num(in,i) 575 : enddo 576 : endif 577 : 2000 continue 578 : * nelrig=imatr4.imattt(/1)-idec 579 : nelrig=xmatr4.re(/3)-idec 580 : nligrp=xmatr4.re(/2) 581 : nligrd=xmatr4.re(/1) 582 : segadj Xmatr4 583 : segdes xmatr4 584 : * write (6,*) ' nelrig dans scnd2 ',nelrig 585 : if (nelrig.eq.0) ri4.irigel(4,irig)=0 586 : nbnn=ipt4.num(/1) 587 : nbelem=ipt4.num(/2)-idec 588 : nbref=0 589 : nbsous=0 590 : segadj ipt4 591 : segsup imatt 592 : segsup trav3 593 : 1000 continue 594 : * il ne reste plus qu'a ranger dans ri4 les nouvelles raideurs engendrées 595 : nrigeo=ri4.irigel(/2) 596 : nrigel=nrigeo+kmatno 597 : * nrige=max(ri4.irigel(/1),7) 598 : segadj ri4 599 : do 3000 irig=nrigeo+1,nrigel 600 : ri4.coerig(irig)=coerno(irig-nrigeo) 601 : ri4.irigel(1,irig)=igeomno(irig-nrigeo) 602 : ri4.irigel(3,irig)=idesno(irig-nrigeo) 603 : ri4.irigel(7,irig)=irg7no(irig-nrigeo) 604 : ri4.irigel(5,irig)=irg5no(irig-nrigeo) 605 : ri4.irigel(2,irig)=irg2no(irig-nrigeo) 606 : ri4.irigel(6,irig)=irg6no(irig-nrigeo) 607 : * nelrig=1 608 : * segini imatri 609 : * imattt(1)=imatno(irig-nrigeo) 610 : * ri4.irigel(4,irig)=imatri 611 : ri4.irigel(4,irig)=imatno(irig-nrigeo) 612 : * if (imattt(1).eq.0) ri4.irigel(4,irig)=0 613 : 3000 continue 614 : * compression de irigel 615 : idec=0 616 : do 2100 irig=1,ri4.irigel(/2) 617 : if (ri4.irigel(4,irig).eq.0) then 618 : idec=idec+1 619 : else 620 : do in=1,ri4.irigel(/1) 621 : ri4.irigel(in,irig-idec)=ri4.irigel(in,irig) 622 : enddo 623 : ri4.coerig(irig-idec)=ri4.coerig(irig) 624 : endif 625 : 2100 continue 626 : * nrige=ri4.irigel(/1) 627 : nrigel=ri4.irigel(/2)-idec 628 : * write (6,*) ' nrigel dans scnd2 ',nrigel 629 : segadj ri4 630 : * write (6,*) ' raideur resultante ' 630 : * call prrigi(ri4) 631 : segsup trav1,trav2,imatno,idesno,igeomno,coerno,irg7no 632 : $ ,irg5no,irg2no,irg6no,svu 633 : * desactivation generale 634 : segact mrigid 635 : do irig=1,irigel(/2) 636 : xmatri=irigel(4,irig) 637 : meleme=irigel(1,irig) 638 : descr=irigel(3,irig) 639 : segdes xmatri,meleme,descr 640 : enddo 641 : segact ri4 642 : do irig=1,ri4.irigel(/2) 643 : xmatri=ri4.irigel(4,irig) 644 : meleme=ri4.irigel(1,irig) 645 : descr=ri4.irigel(3,irig) 646 : segdes xmatri,meleme,descr 647 : enddo 648 : segact ri1 649 : do irig=1,ri1.irigel(/2) 650 : xmatri=ri1.irigel(4,irig) 651 : meleme=ri1.irigel(1,irig) 652 : descr=ri1.irigel(3,irig) 653 : segdes xmatri,meleme,descr 654 : enddo 655 : end 656 : 657 : 658 : 659 : 660 : 661 : 662 : 663 :
© Cast3M 2003 - All rights reserved.
Disclaimer