1 : C SUPRI SOURCE PV 10/10/13 21:15:53 6781 2 : SUBROUTINE SUPRI 3 : c==================================================================== 4 : c sous routine utilis�e par l'op�rateur super option 'rigidite' 5 : c 6 : c on lit une rigidit�e des noeuds maitres(geo ou rigi ou chpoi) 7 : c il sort un objet de type superelement 8 : c 9 : c appel�e par super 10 : c==================================================================== 11 : IMPLICIT INTEGER(I-N) 12 : IMPLICIT REAL*8(A-H,O-Z) 13 : CHARACTER*4 CMOT 14 : character*4 mcle(1) 15 : data mcle/'NOMU'/ 16 : -INC SMSUPER 17 : -INC SMCHPOI 18 : -INC SMRIGID 19 : -INC SMELEME 20 : -INC SMCOORD 21 : -INC CCOPTIO 22 : -INC CCGEOME 23 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 24 : SEGMENT NOINC(NNIN,ITA) 25 : SEGMENT NNOEU(NNIN) 26 : SEGMENT SNOMIN 27 : CHARACTER*4 NOMIN(0) 28 : ENDSEGMENT 29 : SEGMENT SNOMDU 30 : CHARACTER*4 NOMDU(0) 31 : ENDSEGMENT 32 : SEGMENT ITRANS(LISINC(/2)) 33 : SEGMENT INOE(ITA) 34 : c segment/xvl/(xva(nligra)*d) 35 : c segment ipass(nligra) 36 : SEGMENT ISIM(ISIMU) 37 : c 38 : * option NOMUltiplicateur 39 : nomu=0 39 : call lirmot(mcle,1,nomu,0) 40 : 40 : CALL LIROBJ ('RIGIDITE',MRIGID,1,IRETOU) 41 : IF(IERR.NE.0) RETURN 42 : 43 : NEWKEQ=1 44 : c 45 : c *** recuperation des noeuds maitres 46 : c 47 : c_______________________________cas du chpo___________________________________ 48 : c 49 : c 49 : CALL LIROBJ ('CHPOINT ',MCHPOI,0,IRETOU) 50 : IF(IRETOU.EQ.0) GO TO 1000 51 : c 52 : c on vient de lirobj un chpoint on travaille a partir de lui 53 : c 54 : c creation des inconnues dans nomin 55 : c creation de icpr 56 : c creation de noinc(i,j)=1 si inconnues i existe pour le jeme noeud 57 : c 58 : SEGACT MCHPOI 59 : SEGINI SNOMIN,ICPR 60 : ITA=0 61 : NOMIN(**)='LX ' 62 : NNIN=2 63 : DO 1001 I=1,IPCHP(/1) 64 : MSOUPO=IPCHP(I) 65 : SEGACT MSOUPO 66 : MELEME=IGEOC 67 : SEGACT MELEME 68 : IF(I.EQ.1) THEN 69 : NOMIN(**)=NOCOMP(1) 70 : ENDIF 71 : DO 1002 J=1,NOCOMP(/2) 72 : DO 1003 K=1,NOMIN(/2) 73 : IF(NOMIN(K).EQ.NOCOMP(J)) GO TO 1002 74 : 1003 CONTINUE 75 : NNIN=NNIN+1 76 : NOMIN(**)=NOCOMP(J) 77 : 1002 CONTINUE 78 : DO 1004 J=1,NUM(/2) 79 : ICPR(NUM(1,J))=ITA+J 80 : 1004 CONTINUE 81 : ITA =ITA + NUM(/2) 82 : 1001 CONTINUE 83 : SEGINI NOINC 84 : NTPMAI=ITA 85 : ITA=0 86 : DO 1006 I=1,IPCHP(/1) 87 : MSOUPO=IPCHP(I) 88 : MELEME=IGEOC 89 : DO 1007 J=1,NOCOMP(/2) 90 : DO 1008 K=1,NNIN 91 : IF(NOMIN(K).EQ.NOCOMP(J)) GO TO 1009 92 : 1008 CONTINUE 93 : 1009 CONTINUE 94 : KK=K 95 : DO 1010 K=1,NUM(/2) 96 : NOINC(KK,K+ITA)=1 97 : 1010 CONTINUE 98 : 1007 CONTINUE 99 : ITA =ITA+NUM(/2) 100 : SEGDES MELEME,MSOUPO 101 : 1006 CONTINUE 102 : SEGDES MCHPOI 103 : SEGACT MRIGID 104 : c 105 : c ** initialisation de nomdu et verifi que chaque noeud et chaque inco 106 : c existe 107 : DO 1013 I=1,ICPR(/1) 108 : ICPR(I)=-ICPR(I) 109 : 1013 CONTINUE 110 : SEGINI SNOMDU 111 : nomdu(**)='FLX ' 112 : DO 1014 I=2,NOMIN(/2) 113 : NOMDU(**)=' ' 114 : 1014 CONTINUE 115 : DO 1015 I=1,IRIGEL(/2) 116 : MELEME=IRIGEL(1,I) 117 : DESCR=IRIGEL(3,I) 118 : SEGACT MELEME 119 : DO 1016 J=1,NUM(/2) 120 : DO 1016 K=1,NUM(/1) 121 : IP=NUM(K,J) 122 : IF(ICPR(IP).EQ.0) GO TO 1016 123 : ICPR(IP)=ABS(ICPR(IP)) 124 : 1016 CONTINUE 125 : SEGDES MELEME 126 : SEGACT DESCR 127 : DO 1017 K=1,NOMIN(/2) 128 : DO 1018 J=1,LISINC(/2) 129 : IF(NOMIN(K).NE.LISINC(J)) GO TO 1018 130 : NOMDU(K)=LISDUA(J) 131 : GO TO 1017 132 : 1018 CONTINUE 133 : 1017 CONTINUE 134 : SEGDES DESCR 135 : 1015 CONTINUE 136 : DO 1019 I=1,ICPR(/1) 137 : IF(ICPR(I).GE.0) GO TO 1019 137 : CALL ERREUR (293) 138 : RETURN 139 : 1019 CONTINUE 140 : DO 1020 I=1,NOMDU(/2) 141 : IF(NOMDU(I).NE.' ') GO TO 1020 141 : CALL ERREUR (293) 142 : RETURN 143 : 1020 CONTINUE 144 : NBNN=ITA 145 : NBSOUS=0 146 : NBREF=0 147 : NBELEM=1 148 : SEGINI MELEME 149 : ITYPEL=1 150 : IMELE=MELEME 151 : DO 1021 I=1,ICPR(/1) 152 : IF(ICPR(I).EQ.0) GO TO 1021 153 : NUM(ICPR(I),1)=I 154 : 1021 CONTINUE 155 : SEGDES MELEME 156 : GO TO 1011 157 : c 158 : c_____________________________cas de rigi___________________________________ 159 : c 160 : 1000 CONTINUE 160 : CALL LIROBJ ('RIGIDITE',MRIG,0,IRETOU) 161 : IF(IRETOU.EQ.0) GO TO 1500 162 : ITA=0 163 : NNIN=0 164 : c 165 : RI1=MRIG 166 : SEGACT RI1 167 : c 168 : SEGINI SNOMIN,SNOMDU,ICPR 169 : nomin(**)='LX ' 170 : nomdu(**)='FLX ' 171 : c 172 : DO 1501 I=1,RI1.IRIGEL(/2) 173 : MELEME=RI1.IRIGEL(1,I) 174 : SEGACT MELEME 175 : DESCR=RI1.IRIGEL(3,I) 176 : SEGACT DESCR 177 : DO 1502 J=1,LISINC(/2) 178 : IF(LISINC(J).EQ.'LX '.AND.J.LE.1) GO TO 1502 179 : DO 1503 K=1,NUM(/2) 180 : IP=NUM(NOELEP(J),K) 181 : IF(ICPR(IP).NE.0) GO TO 1503 182 : ITA=ITA+1 183 : ICPR(IP)=ITA 184 : 1503 CONTINUE 185 : IF(NOMIN(/2).EQ.0) THEN 186 : NOMIN(**)=LISINC(J) 187 : NOMDU(**)=LISDUA(J) 188 : ELSE 189 : DO 1504 K=1,NOMIN(/2) 190 : IF(LISINC(J).EQ.NOMIN(K)) GO TO 1505 191 : 1504 CONTINUE 192 : NOMIN(**)=LISINC(J) 193 : NOMDU(**)=LISDUA(J) 194 : 1505 CONTINUE 195 : ENDIF 196 : 1502 CONTINUE 197 : SEGDES MELEME,DESCR 198 : 1501 CONTINUE 199 : c 200 : NNIN=NOMIN(/2) 201 : NTPMAI=ITA 202 : c 203 : SEGINI NOINC 204 : c 205 : DO 1506 I=1,RI1.IRIGEL(/2) 206 : MELEME=RI1.IRIGEL(1,I) 207 : DESCR=RI1.IRIGEL(3,I) 208 : c 209 : SEGACT MELEME,DESCR 210 : DO 1507 J=1,LISINC(/2) 211 : IF(LISINC(J).EQ.'LX '.AND.J.LE.1) GO TO 1507 212 : IP=NOELEP(J) 213 : DO 1509 KK=1,NOMIN(/2) 214 : IF(NOMIN(KK).EQ.LISINC(J)) GO TO 1510 215 : 1509 CONTINUE 216 : 1510 CONTINUE 217 : DO 1508 K=1,NUM(/2) 218 : IPP=ICPR(NUM(IP,K)) 219 : NOINC(KK,IPP)=1 220 : 1508 CONTINUE 221 : 1507 CONTINUE 222 : SEGDES MELEME,DESCR 223 : 1506 CONTINUE 224 : SEGDES RI1 225 : c 226 : NBNN=ITA 227 : NBSOUS=0 228 : NBREF=0 229 : NBELEM=1 230 : SEGINI MELEME 231 : c 232 : ITYPEL=1 233 : IMELE=MELEME 234 : c 235 : DO 1511 I=1,ICPR(/1) 236 : IF(ICPR(I).EQ.0) GO TO 1511 237 : NUM(ICPR(I),1)=I 238 : 1511 CONTINUE 239 : 1512 CONTINUE 240 : c 241 : SEGDES MELEME 242 : GO TO 1011 243 : c 244 : c____________________________cas de geo_______________________________ 245 : c 246 : 1500 CONTINUE 247 : c 247 : CALL LIROBJ ('POINT ',MELEME,0,IRETOU) 247 : IF(IRETOU.NE.0) CALL CRELEM(MELEME) 247 : IF(IRETOU.EQ.0) CALL LIROBJ ('MAILLAGE',MELEME,1,IRETOU) 248 : IF(IERR.NE.0) RETURN 248 : CALL CHANGE(MELEME,1) 249 : SEGINI,IPT1=MELEME 250 : SEGDES,IPT1 251 : c 252 : c ** on fabrique une numerotation interne uniquement les noeuds 253 : c ** maitres. 254 : c 255 : SEGINI ICPR 256 : ITE=0 257 : DO 1 I = 1,NUM(/2) 258 : IP= NUM(1,I) 259 : IF(ICPR(IP).NE.0) GO TO 1 260 : ITE=ITE+1 261 : ICPR(IP)=ITE 262 : 1 CONTINUE 263 : NTPMAI=ITE 264 : ITA=ITE 265 : c 266 : c___________on cherche la liste des inconnues pour chaque noeuds___________ 267 : c 268 : SEGDES MELEME 269 : SEGACT MRIGID 270 : DESCR=IRIGEL(3,1) 271 : SEGACT DESCR 272 : SEGINI SNOMIN 273 : SEGINI SNOMDU 274 : nomin(**)='LX ' 275 : nomdu(**)='FLX ' 276 : DO 2 I=1,IRIGEL(/2) 277 : DESCR=IRIGEL(3,I) 278 : SEGACT DESCR 279 : DO 4 J=1,LISINC(/2) 280 : NO=NOMIN(/2) 281 : DO 5 K=1,NO 282 : IF(NOMIN(K).EQ.LISINC(J)) GO TO 4 283 : 5 CONTINUE 284 : NOMIN(**)=LISINC(J) 285 : NOMDU(**)=LISDUA(J) 286 : 4 CONTINUE 287 : SEGDES DESCR 288 : 2 CONTINUE 289 : NNIN=NOMIN(/2) 290 : c 291 : c ** on cree le tableau noinc(i,j)=1 si la ieme inconnue existe pour 292 : c ** le jeme noeud 293 : c ** itrans donne pour chaque descr la correspondance entre lisinc et 294 : c *** la liste des inconnues 295 : c 296 : SEGINI NOINC 297 : KN=NOMIN(/2) 298 : DO 6 I=1,IRIGEL(/2) 299 : DESCR=IRIGEL(3,I) 300 : SEGACT DESCR 301 : SEGINI ITRANS 302 : DO 10 L=1,LISINC(/2) 303 : DO 11 M=1,NNIN 304 : IF( LISINC(L).NE.NOMIN(M)) GO TO 11 305 : * itrans relie lisinc � nomin 306 : ITRANS(L)=M 307 : GO TO 10 308 : 11 CONTINUE 309 : 10 CONTINUE 310 : MELEME=IRIGEL(1,I) 311 : SEGACT MELEME 312 : DO 3 J=1,NUM(/2) 313 : DO 3 K = 1,NUM(/1) 314 : IP=NUM(K,J) 315 : IF(ICPR(IP).EQ.0) GO TO 3 316 : IT=ICPR(IP) 317 : DO 8 L=1,LISINC(/2) 318 : IF(NOELEP(L).NE.K) GO TO 8 319 : NOINC(ITRANS(L),IT)=1 320 : 8 CONTINUE 321 : 3 CONTINUE 322 : SEGDES MELEME 323 : SEGDES DESCR 324 : SEGSUP ITRANS 325 : 6 CONTINUE 326 : * 327 : SEGACT IPT1 328 : NBELEM=1 329 : NBNN=IPT1.NUM(/2) 330 : NBREF=0 331 : NBSOUS=0 332 : SEGINI MELEME 333 : c do 51 i=1,nbnn 334 : c num(i,1)=ipt1.num(1,i) 335 : c 51 continue 336 : ICOLOR(1)=IDCOUL 337 : ITYPEL=28 338 : SEGDES IPT1 339 : DO 52 I=1,ICPR(/1) 340 : IF(ICPR(I).EQ.0) GO TO 52 341 : NUM(ICPR(I),1)=I 342 : 52 CONTINUE 343 : SEGDES MELEME 344 : c 345 : c ** verification tous les points maitres 346 : c 347 : DO 16 I=1,ITA 348 : DO 17 J=1,NNIN 349 : IF(NOINC(J,I).NE.0) GO TO 16 350 : 17 CONTINUE 351 : WRITE(*,*) 'CAS DE GEO' 351 : CALL ERREUR(293) 352 : RETURN 353 : 16 CONTINUE 354 : c 355 : 1011 CONTINUE 356 : c 357 : c ______________________partie commune___________________________ 358 : c 359 : c 360 : * en l'absence du mot cle NOMU, on va rajouter dans les noeuds maitres 361 : * les multiplicateurs de lagrange des relations portant sur ceux-ci 362 : * ca permet ulterieurement d'utiliser un chargement sur ces 363 : * multiplicateurs 364 : * 365 : * En presence du mot cle NOMU, on ne modifie pas la liste des noeuds 366 : * maitres. 367 : * 368 : c 369 : c ** on trie la rigidite initiale pour mettre de cote les bloquages 370 : c ** et relations qui concernent uniquement les noeuds maitres. 371 : c ** ri4 contiendra la rigidite sans ces bloquages, ri5 contiendra 372 : c ** uniquement ces bloquages. on fait deux passages pour pouvoir 373 : c ** dimensionner irigel 374 : c ** on effectue un traitement particulier pour les ddls de lagrange 375 : c ** maitres 376 : c 377 : segact mrigid 378 : segini,ri4=mrigid 379 : segini,ri5=mrigid 380 : nrig=irigel(/2) 381 : do 800 ir=1,nrig 382 : ipt3=irigel(1,ir) 383 : segact ipt3 384 : if (ipt3.itypel.ne.22) then 385 : ri5.irigel(1,ir)=0 386 : goto 800 387 : endif 388 : segini,ipt4=ipt3 389 : ri4.irigel(1,ir)=ipt4 390 : segini,ipt5=ipt3 391 : ri5.irigel(1,ir)=ipt5 392 : descr=irigel(3,ir) 393 : segact descr 394 : xmatri=irigel(4,ir) 395 : segact xmatri 396 : segini,xmatr4=xmatri 397 : ri4.irigel(4,ir)=xmatr4 398 : segini,xmatr5=xmatri 399 : ri5.irigel(4,ir)=xmatr5 400 : iel4=0 401 : iel5=0 402 : do 810 iel=1,ipt3.num(/2) 403 : iaf=0 404 : ir5=1 405 : do 820 ipt=2,noelep(/1) 406 : if (icpr(ipt3.num(noelep(ipt),iel)).ne.0) then 407 : do k=1,nomin(/2) 408 : if (nomin(k).eq.lisinc(ipt)) goto 821 409 : enddo 410 : ir5=0 411 : goto 820 412 : 821 continue 413 : if (noinc(k,icpr(ipt3.num(noelep(ipt),iel))).eq.1) iaf=1 414 : if (noinc(k,icpr(ipt3.num(noelep(ipt),iel))).eq.0) ir5=0 415 : else 416 : ir5=0 417 : endif 418 : 820 continue 419 : if (iaf.eq.1.and.nomu.eq.0.and.ir5.eq.0) then 420 : * il faut rajouter le mult de lagrange dans les noeuds maitres 421 : if (icpr(ipt3.num(noelep(1),iel)).eq.0) then 422 : ita=ita+1 423 : icpr(ipt3.num(noelep(1),iel))=ita 424 : segadj noinc 425 : endif 426 : 427 : * write (6,*) ' mult transforme maitre ', 428 : * > icpr(ipt3.num(noelep(1),iel)) 429 : noinc(1,icpr(ipt3.num(noelep(1),iel)))=1 430 : endif 431 : *** ir5=0 432 : if (ir5.eq.1) then 433 : iel5=iel5+1 434 : do ip=1,ipt3.num(/1) 435 : ipt5.num(ip,iel5)=ipt3.num(ip,iel) 436 : enddo 437 : do io=1,re(/2) 438 : do iu=1,re(/1) 439 : xmatr5.re(iu,io,iel5)=re(iu,io,iel) 440 : enddo 441 : enddo 442 : * imatr5.imattt(iel5)=imattt(iel) 443 : else 444 : iel4=iel4+1 445 : do ip=1,ipt3.num(/1) 446 : ipt4.num(ip,iel4)=ipt3.num(ip,iel) 447 : enddo 448 : do io=1,re(/2) 449 : do iu=1,re(/1) 450 : xmatr4.re(iu,io,iel4)=re(iu,io,iel) 451 : enddo 452 : enddo 453 : * imatr4.imattt(iel4)=imattt(iel) 454 : endif 455 : 810 continue 456 : nbnn=ipt3.num(/1) 457 : nbsous=0 458 : nbref=0 459 : nbelem=iel5 460 : segadj ipt5 461 : nbelem=iel4 462 : segadj ipt4 463 : nelrig=iel5 464 : segact xmatr5*mod 465 : nligrp=xmatr5.re(/2) 466 : nligrd=xmatr5.re(/1) 467 : segadj xmatr5 468 : segact xmatr4*mod 469 : nligrp=xmatr4.re(/2) 470 : nligrd=xmatr4.re(/1) 471 : nelrig=iel4 472 : segadj xmatr4 473 : segdes xmatri,xmatr4,xmatr5 474 : 800 continue 475 : 476 : c 477 : c calcul de la rigidite equivalente 478 : c 479 : lagdua=0 480 : * write (6,*) ' ri4 avant dbblx ' 480 : * call prrigi(ri4,0) 480 : call dbblx(ri4,lagdua) 481 : * write (6,*) ' ri4 avant calkeq ' 481 : * call prrigi(ri4,0) 482 : * write (6,*) ' ri5 avant calkeq ' 482 : * call prrigi(ri5,0) 483 : * segdes xmatri 483 : CALL CALKEQ(ri4,NOINC,SNOMIN,ICPR,XMATR1,DES1,ICROUT) 484 : c 485 : if (ierr.ne.0) return 486 : SEGACT,NOINC,icpr 487 : NLIGRA=0 488 : DO 14 I=1,ITA 489 : DO 14 J=1,NNIN 490 : NLIGRA=NLIGRA+NOINC(J,I) 491 : 14 CONTINUE 492 : c 493 : c creation de la raideur 494 : c 495 : c 496 : c creation des blocages a ajouter a mrigto 497 : c 498 : nligrp=1 499 : nligrd=1 500 : nelrig=1 501 : segini xmatr2 502 : segdes xmatr2 503 : * segini imatr2 504 : * imatr2.imattt(1)=xmatr2 505 : * segdes imatr2 506 : SEGACT RI4 507 : SEGACT DES1 508 : IP=RI4.IRIGEL(/2) 509 : NRIGEL=IP+NLIGRA 510 : NRIGE=MAX(8,IRIGEL(/1)) 511 : SEGINI RI2 512 : ri2.MTYMAT='RIGIDITE' 513 : ri2.IFORIG=IFOMOD 514 : * write (6,*) ' ita ',ita 515 : NBNN=ITA 516 : NBSOUS=0 517 : NBREF=0 518 : NBELEM=1 519 : SEGINI MELEME 520 : c 521 : ITYPEL=28 522 : c 523 : DO 1611 I=1,ICPR(/1) 524 : IF(ICPR(I).EQ.0) GO TO 1611 525 : NUM(ICPR(I),1)=I 526 : 1611 CONTINUE 526 : * call ecmail(meleme,0) 527 : segact meleme 528 : imele=meleme 529 : NBREF=0 530 : NBSOUS=0 531 : NBNN=1 532 : NBELEM=1 533 : DO 15 I=1,NLIGRA 534 : SEGINI IPT1 535 : IPT1.ITYPEL=1 536 : * write (6,*) ' des1.noelep ',des1.noelep(i) 537 : IPT1.NUM(1,1)=NUM(DES1.NOELEP(I),1) 538 : ri2.irigel(1,i)=ipt1 539 : segdes ipt1 540 : segini des2 541 : des2.lisinc(1)=DES1.LISINC(I) 542 : des2.lisdua(1)=DES1.LISdua(I) 543 : des2.noelep(1)=1 544 : des2.noeled(1)=1 545 : segdes des2 546 : ri2.irigel(3,i)=des2 547 : ri2.irigel(4,i)=xmatr2 548 : ri2.irigel(5,i)=nifour 549 : 15 CONTINUE 550 : iplus=0 551 : DO 25 I=1,IP 552 : ipt4=ri4.irigel(1,i) 553 : segact ipt4 554 : if (ipt4.num(/2).ne.0) then 555 : iplus=iplus+1 556 : DO 26 J=1,ri4.irigel(/1) 557 : RI2.IRIGEL(J,Iplus+NLIGRA)=ri4.IRIGEL(J,I) 558 : 26 CONTINUE 559 : RI2.COERIG(Iplus+NLIGRA)=ri4.COERIG(I) 560 : endif 561 : 25 CONTINUE 562 : nrigel=iplus+nligra 563 : segadj ri2 564 : c 565 : * write (6,*) ' ri4 modifie ' 565 : * call prrigi(ri4,1) 566 : SEGINI MSUPER 567 : MBLOQU=NLIGRA 568 : MRIGTO=ri2 569 : SEGDES ri2 570 : NRIGE=8 571 : NELRIG=1 572 : NRIGEL=1 573 : SEGINI MRIGID 574 : COERIG(1)=1.D0 575 : * SEGINI IMATRI 576 : * IMATTT(1)=XMATR1 577 : MTYMAT='RIGIDITE' 578 : IFORIG=IFOMOD 579 : IRIGEL(1,1)=MELEME 580 : IRIGEL(2,1)=0 581 : IRIGEL(3,1)=DES1 582 : IRIGEL(4,1)=xMATR1 583 : IRIGEL(5,1)=NIFOUR 584 : IRIGEL(6,1)=0 585 : 586 : segact ri5 587 : nrigel5=ri5.irigel(/2) 588 : nrigel=1+nrigel5 589 : segadj mrigid 590 : iplus=0 591 : do ir=1,ri5.irigel(/2) 592 : meleme=ri5.irigel(1,ir) 593 : if (meleme.ne.0) then 594 : segact meleme 595 : if (num(/2).ne.0) then 596 : iplus=iplus+1 597 : do id=1,ri5.irigel(/1) 598 : irigel(id,1+iplus)=ri5.irigel(id,ir) 599 : enddo 600 : coerig(1+iplus)=ri5.coerig(ir) 601 : endif 602 : segdes meleme 603 : endif 604 : enddo 605 : nrigel=1+iplus 606 : segadj mrigid 607 : c si des inconnues maitres ont ete normalis�e il faut modifier la 608 : c la matrice condens�e 609 : if (ierr.ne.0) return 610 : * segdes xmatri 610 : CALL SUPNRM(ICROUT,MRIGID,norr) 611 : mdnorr=norr 612 : * segdes xmatri 613 : segact mrigid*mod 614 : c 615 : MCROUT=ICROUT 616 : msuper.islag=lagdua 617 : mrigid.imlag=lagdua 618 : * write (6,*) ' msurai lagdua dans supri ',mrigid,lagdua 619 : * ici on rajoute 620 : meleme=imele 621 : SEGDES MELEME 622 : * SEGDES xMATRI 623 : SEGDES MRIGID 624 : SEGSUP ICPR,SNOMIN,SNOMDU,NOINC 625 : SEGDES DES1 626 : MSURAI=MRIGID 627 : * write (6,*) ' mrigto *************************' 627 : * call prrigi(mrigto,0) 628 : * write (6,*) ' msurai *************************' 628 : * call prrigi(msurai,0) 629 : MSUPEL=imele 630 : SEGDES MSUPER 631 : * 631 : CALL ECROBJ ('SUPERELE',MSUPER) 632 : * 633 : RETURN 634 : END 635 : 636 : 637 :
© Cast3M 2003 - All rights reserved.
Disclaimer