1 : C RIGI1 SOURCE BP208322 13/10/02 21:15:21 7830 2 : 3 : SUBROUTINE RIGI1(MODORI,IPCHE1,IPCHE2,IMAT, IPOI6,IRET) 4 : *---------------------------------------------------------------------* 5 : * * 6 : * OPERATEUR RIGIDITE * 7 : * * 8 : *---------------------------------------------------------------------* 9 : * * 10 : * CE SOUS-PROGRAMME SERT A TRAITER ET A METTRE EN FORME * 11 : * LES INFORMATIONS NECESSAIRES POUR LES CALCULS * 12 : * * 13 : *---------------------------------------------------------------------* 14 : * * 15 : * ENTREES : * 16 : * ________ * 17 : * * 18 : * MODORI Pointeur sur le modele * 19 : * IPCHE1 Pointeur sur le chamelem de carateristiques * 20 : * IPCHE2 Pointeur sur le chamelem de matrice de HOOKE * 21 : * IMAT (2 il y a une matrice de HOOKE,1 non ) * 22 : * * 23 : * SORTIES : * 24 : * ________ * 25 : * * 26 : * IPOI6 pointeur sur la rigidite construite * 27 : * IRET (1 OK , 0 erreur ) * 28 : * * 29 : *---------------------------------------------------------------------* 30 : IMPLICIT INTEGER(I-N) 31 : IMPLICIT REAL*8(A-H,O-Z) 32 : * 33 : -INC CCOPTIO 34 : -INC CCHAMP 35 : -INC CCGEOME 36 : -INC CCREEL 37 : *- 38 : -INC SMCHAML 39 : -INC SMINTE 40 : -INC SMELEME 41 : -INC SMRIGID 42 : -INC SMMODEL 43 : -INC SMCOORD 44 : -INC SMLREEL 45 : C 46 : integer oooval 47 : 48 : SEGMENT INFO 49 : INTEGER INFELL(JG) 50 : ENDSEGMENT 51 : 52 : POINTEUR NOMID1.NOMID 53 : * 54 : SEGMENT NOTYPE 55 : CHARACTER*16 TYPE(NBTYPE) 56 : ENDSEGMENT 57 : * 58 : SEGMENT MPTVAL 59 : INTEGER IPOS(NS) ,NSOF(NS) 60 : INTEGER IVAL(NCOSOU) 61 : CHARACTER*16 TYVAL(NCOSOU) 62 : ENDSEGMENT 63 : * 64 : segment modsta 65 : integer pimoda(nmoda),pistat(nstat) 66 : integer ivmoda(nmoda),ivstat(nstat) 67 : endsegment 68 : * 69 : CHARACTER*8 CMATE 70 : CHARACTER*(NCONCH) CONM 71 : PARAMETER ( INTTYP=3 ) 72 : * INTTYP DEFINIT LE TYPE DE POINTS D'INTEGRATION 73 : * UTILISE PAR RIGI 74 : PARAMETER ( NINF=3 ) 75 : INTEGER INFOS(NINF) 76 : LOGICAL BDPGE,ldpge,lsupfo,lsupdp,lsupma,dcmate,dcmat2 77 : * 78 : * Petit tableau des "couleurs" des relations de conformite (goto 31) 79 : DIMENSION LCOLOR(6) 80 : DATA LCOLOR / 1, 3, 6, 10, 16, 24 / 81 : * 82 : IRET = 0 83 : IPOI6 = 0 84 : * 85 : * ACTIVATION DU MODELE 86 : * -------------------- 87 : * MODORI = Modele initial complet 88 : * IPMODL = Modele "deroule" (uniquement "MECANIQUE", "LIQUIDE" ou "POREUX") 88 : CALL PIMODL(MODORI,IPMODL) 89 : IF (IPMODL.EQ.0) RETURN 90 : * IPMODL est ACTIF en retour (nouveau pointeur pouvant etre detruit) 91 : MMODEL=IPMODL 92 : NSOUS = KMODEL(/1) 93 : * 94 : * VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES 95 : * ZZZZZZZZ PEUT ETRE A FAIRE PLUTOT SUR LES SOUS-ZONES 96 : * 97 : ISUP=0 98 : IF(IPCHE1.NE.0)THEN 99 : * reduction 99 : * call zpchel(ipche1,1) 99 : call reduaf(ipche1,modori,ipche10,0,iretca,kerr) 99 : * call zpchel(ipche10,1) 99 : if (iretca.ne.1) call erreur(kerr) 100 : if (ierr.ne.0) goto 889 101 : ipche1=ipche10 101 : CALL QUESUP(MMODEL,IPCHE1,INTTYP,0,ISUP,IRETCA) 102 : IF (ISUP.GT.1) GOTO 889 103 : ENDIF 104 : * 105 : * VERIFICATION DU LIEU SUPPORT DU MCHAML DE HOOKE 106 : * 107 : ISUP1 = 0 108 : IPCHOO = 0 109 : IF (IMAT.EQ.2) THEN 110 : IPCHOO = IPCHE1 111 : IF (IPCHE2.NE.0) THEN 112 : IPCHOO = IPCHE2 112 : CALL QUESUP(MMODEL,IPCHE2,INTTYP,1,ISUP1,IRETHO) 113 : IF (ISUP1.NE.0) GOTO 889 114 : ENDIF 115 : ENDIF 116 : * 117 : SEGACT MMODEL 118 : * INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE 119 : * --------------------------------------------- 120 : NRIGEL=0 121 : SEGINI,MRIGID 122 : MTYMAT = 'RIGIDITE' 123 : IFORIG=IFOUR 124 : ICHOLE=0 125 : IMGEO1=0 126 : IMGEO2=0 127 : ISUPEQ=0 128 : 129 : C Cas des modes de calculs en DEFORMATIONS GENERALISEES 130 : IF (IFOUR.EQ.-3) THEN 131 : NDPGE=3 132 : BDPGE=.TRUE. 133 : ELSE IF (IFOUR.EQ.11) THEN 134 : NDPGE=2 135 : BDPGE=.TRUE. 136 : ELSE IF (IFOUR.EQ. 7.OR.IFOUR.EQ. 8.OR.IFOUR.EQ. 9.OR. 137 : . IFOUR.EQ.10.OR.IFOUR.EQ.14) THEN 138 : NDPGE=1 139 : BDPGE=.TRUE. 140 : ELSE 141 : NDPGE=0 142 : BDPGE=.FALSE. 143 : ENDIF 144 : * 145 : * termes croises STATIQUE et/ou MODAL 146 : nstat = 100 147 : kstat = 0 148 : nmoda = 100 149 : kmoda = 0 150 : segini modsta 151 : *--------------------------------------------------------------------* 152 : * 153 : * BOUCLE SUR LES ZONES ELEMENTAIRES ( MEME TYPE D'EF ) 154 : * 155 : *--------------------------------------------------------------------* 156 : * ETAT ACTUEL DES SEGMENTS : MRIGID ACTIF , MMODEL ACTIF 157 : * IPCHE1 INACTIF, IPCHE2 INACTIF 158 : * 159 : ISOU=0 160 : DO 500 ISOUS=1,NSOUS 161 : * 162 : IMODEL=KMODEL(ISOUS) 163 : SEGACT IMODEL 164 : * 165 : * INITIALISATIONS 166 : * 167 : IIPDPG=IPDPGE 168 : MELE = NEFMOD 169 : IPMAIL= IMAMOD 170 : CONM = CONMOD 171 : * 172 : IVAMAT=0 173 : IVACAR=0 174 : NMATR=0 175 : NMATF=0 176 : NCARA=0 177 : NCARF=0 178 : MOCARA=0 179 : MOMATR=0 180 : DESCR=0 181 : xMATRI=0 182 : lsupma=.true. 183 : dcmate = .false. 184 : dcmat2 = .false. 185 : IPMINT = 0 186 : C 187 : IF (MELE.EQ.22) GOTO 310 188 : C 189 : C COQUE INTEGREE OU PAS ? 190 : C 191 : IF(INFMOD(/1).NE.0)THEN 192 : NPINT=INFMOD(1) 193 : ELSE 194 : NPINT=0 195 : ENDIF 196 : * 197 : * VERIFICATION SUR LA FORMULATION 198 : * 199 : * NFOR = FORMOD(/2) 200 : * NMAT = MATMOD(/2) 200 : * CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) 201 : CMATE = CMATEE 202 : MATE = IMATEE 203 : INAT = INATUU 204 : * IF (CMATE.EQ.' ')THEN 205 : * MESSERR = TENTATIVE D'UTILISATION D'1 OPTION NON IMPLANTE 205 : * CALL ERREUR(251) 206 : * GOTO 888 207 : * ENDIF 208 : do im = 1,matmod(/2) 209 : if (matmod(im).eq.'IMPEDANCE') then 210 : dcmate =.true. 211 : if(tymode(/2).gt.0)then 212 : if(tymode(1).eq.'LISTMOTS') dcmat2 = .true. 213 : endif 214 : endif 215 : enddo 216 : * 217 : * CREATION DU TABLEAU INFOS 218 : * 219 : IRTD=1 219 : CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,IRTD) 220 : IF (IRTD.EQ.0) GOTO 518 221 : * 222 : 223 : *רררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר 224 : * P H A S E 1 225 : * 226 : * INFOS. ELEMENT FINI ET COMPOSANTES NECESSAIRES 227 : * DANS LES CHAMPS EN ENTREE ET EVENTUELLEMENT EN SORTIE 228 : * 229 : * ON POURRAIT REGROUPER LA PLUS GROSSE PARTIE DE CETTE PHASE DANS 230 : * UN SOUS-PROGRAMME COMMUN A BEAUCOUP D'OPERATEURS 231 : * 232 : *רררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר 233 : * 234 : if(infmod(/1).lt.2+inttyp) then 234 : CALL ELQUOI(MELE,0,INTTYP,IPINF,IMODEL) 235 : * 236 : IF ( IERR.NE.0 ) GOTO 888 237 : * 238 : INFO = IPINF 239 : NSTRS = INFELL(16) 240 : MFR = INFELL(13) 241 : LW = INFELL(7) 242 : NDDL = INFELL(15) 243 : IELE = INFELL( 14) 244 : LRE = INFELL(9) 245 : IPORE = INFELL(8) 246 : LHOOK = INFELL(10) 247 : NBPGAU= INFELL( 6) 248 : ICARA = INFELL( 5) 249 : MINTE = INFELL(11) 250 : MINTE1= INFELL(12) 251 : SEGSUP,INFO 252 : else 253 : NSTRS = INFELE(16) 254 : MFR = INFELE(13) 255 : LW = INFELE(7) 256 : NDDL = INFELE(15) 257 : IELE = INFELE( 14) 258 : LRE = INFELE(9) 259 : IPORE = INFELE(8) 260 : LHOOK = INFELE(10) 261 : NBPGAU= INFELE( 6) 262 : ICARA = INFELE( 5) 263 : MINTE = INFMOD(2+INTTYP) 264 : MINTE1= INFMOD(8) 265 : endif 266 : IPMINT=MINTE 267 : IPMIN1=MINTE1 268 : if(mele.ne.260) SEGACT MINTE 269 : ldpge = BDPGE 270 : IF (MFR.EQ.71 .OR. MFR.EQ.73) ldpge = .FALSE. 271 : 310 continue 272 : * Si necessaire partitionnement du xmatri 273 : ipt1=ipmail 274 : segact ipt1 275 : ltrk=oooval(1,4) 276 : if (ltrk.eq.0) ltrk=oooval(1,1) 277 : nbnn1 =ipt1.num(/1) 278 : nbele1=ipt1.num(/2) 279 : if (nefmod.eq.22) lre=nbnn1 280 : * 281 : * traitement particulier pour milieu poreux 282 : IDECAP=0 283 : IF (MELE.GE.79.AND.MELE.LE.83) THEN 284 : IDECAP=1 285 : LRE = LRE + 2*NBNN1 - IPORE 286 : ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN 287 : IDECAP=1 288 : LRE = LRE + (3*NBNN1 - IPORE)/2 - NBSOM(IELE) 289 : ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN 290 : IDECAP=2 291 : LRE = LRE + (2*NBNN1 - IPORE)*IDECAP 292 : ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN 293 : IDECAP=3 294 : LRE = LRE + (2*NBNN1 - IPORE)*IDECAP 295 : ENDIF 296 : * Ajout a la taille en mots de la matrice des infos du segment 297 : lseg=lre*lre*nbele1 + 16 298 : nblprt=(lseg-1)/ltrk+1 299 : nblmax=(nbele1-1)/nblprt+1 300 : nblprt=(nbele1-1)/nblmax+1 301 : * write(ioimp,*) ' rigi1 nblprt nblmax ',nblprt,nblmax,nbele1 302 : meleme=ipt1 303 : 304 : nrigel = IRIGEL(/2) + NBLPRT 305 : SEGADJ,MRIGID 306 : IPOI6=MRIGID 307 : 308 : do 505 iprt=1,nblprt 309 : isou=isou+1 310 : if (nblprt.ne.1) then 311 : segact ipt1 312 : nbsous=0 313 : nbref=0 314 : nbnn=nbnn1 315 : inelem = (iprt-1) * nblmax 316 : nbelem=min(nblmax,nbele1-inelem) 317 : * write(ioimp,*) ' creation segment ',nbnn,nbelem 318 : segini meleme 319 : itypel=ipt1.itypel 320 : do il=1,nbelem 321 : jl = il + inelem 322 : do ip=1,nbnn 323 : num(ip,il)=ipt1.num(ip,jl) 324 : enddo 325 : icolor(il)=ipt1.icolor(jl) 326 : enddo 327 : endif 328 : nbnn=nbnn1 329 : ipmail=meleme 330 : IF (MELE.EQ.22) GOTO 31 331 : C* Cas particulier des elements XFEM en cas de partition : 332 : C* Il faut aussi partitionner le modele (nomme imoxfem) 333 : IF (MFR.EQ.63) THEN 334 : IF (nblprt.GT.1) THEN 335 : imoxfem = 0 335 : CALL PARTXR(IMODEL,ipmail,imoxfem) 336 : ELSE 337 : imoxfem = IMODEL 338 : ENDIF 339 : ENDIF 340 : 341 : IPPORE=0 342 : IF(MFR.EQ.33) THEN 343 : IPPORE=NBNNE(NUMGEO(MELE)) 344 : ELSE IF(MFR.EQ.57.OR.MFR.EQ.59) THEN 345 : IPPORE=NBNNE(NUMGEO(MELE)) 346 : LHOOK=4 347 : IF(IFOUR.EQ.1.OR.IFOUR.EQ.-3) LHOOK=6 348 : ENDIF 349 : LHOO2 = LHOOK*LHOOK 350 : * 351 : * SEGMENTS D'INTEGRATION 352 : * 353 : * Minte : 1er segment d'integration, il existe pour tous les e.f. 354 : * Minte1: 2eme segment d'integration, uniquement pour certains e.f. 355 : * en particulier pour Coq6 et Coq8 356 : * nbpg:nb de points de gauss = nbpgau du segment minte 357 : * iele:no d'element geometrique associe a l'e.f. mele 358 : * nbff:nb de fonctions de forme = nbno du segment minte 359 : * 360 : * TRAITEMENT DES CHAMPS EN ENTREE 361 : * ------------------------------- 362 : * 363 : * >>> CHAMP DE MATRICES DE HOOKE 364 : * 365 : IF (IMAT.EQ.2) THEN 366 : IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN 367 : NBROBL=3 368 : NBRFAC=0 369 : SEGINI NOMID 370 : LESOBL(1)='MAHO' 371 : LESOBL(2)='V1X ' 372 : LESOBL(3)='V1Y ' 373 : NBTYPE=3 374 : SEGINI NOTYPE 375 : TYPE(1)='POINTEURLISTREEL' 376 : TYPE(2)='REAL*8' 377 : TYPE(3)='REAL*8' 378 : ELSE 379 : NBROBL=1 380 : NBRFAC=0 381 : SEGINI NOMID 382 : LESOBL(1)='MAHO' 383 : NBTYPE=1 384 : SEGINI NOTYPE 385 : TYPE(1)='POINTEURLISTREEL' 386 : ENDIF 387 : MOMATR=NOMID 388 : MOTYPE=NOTYPE 389 : NMATR=NBROBL 390 : NMATF=NBRFAC 391 : * 391 : CALL KOMCHA(IPCHOO,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 392 : SEGSUP NOTYPE 393 : IF (IERR.NE.0) GOTO 9991 394 : * 395 : MPTVAL=IVAMAT 396 : MELVAL=IVAL(1) 397 : NBGMAT=IELCHE(/1) 398 : NELMAT=IELCHE(/2) 399 : NMATT=NMATR+NMATF 400 : IF(IPCHE2.EQ.0.AND.ISUP.EQ.1)THEN 400 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 401 : IF(IERR.NE.0)THEN 402 : ISUP=0 403 : GOTO 9991 404 : ENDIF 405 : ENDIF 406 : ELSE 407 : * 408 : * >>> CHAMP DE MATERIAU 409 : * 410 : IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN 411 : NBROBL=2 412 : NBRFAC=0 413 : SEGINI NOMID 414 : MOMATR=NOMID 415 : IF (MFR.EQ.35) THEN 416 : LESOBL(1)='KS ' 417 : LESOBL(2)='KN ' 418 : ELSE IF(MFR.EQ.53) THEN 419 : NBROBL=1 420 : SEGADJ,NOMID 421 : LESOBL(1)='KS ' 422 : ELSE 423 : LESOBL(1)='YOUN' 424 : LESOBL(2)='NU ' 425 : ENDIF 426 : NMATR=NBROBL 427 : NMATF=NBRFAC 428 : ELSE 429 : $ IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN 430 : IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN 431 : NBROBL=7 432 : NBRFAC=0 433 : SEGINI NOMID 434 : MOMATR=NOMID 435 : LESOBL(1)='YOUN' 436 : LESOBL(2)='V1X ' 437 : LESOBL(3)='V1Y ' 438 : LESOBL(4)='V1Z ' 439 : LESOBL(5)='V2X ' 440 : LESOBL(6)='V2Y ' 441 : LESOBL(7)='V2Z ' 442 : ELSE 443 : NBROBL=3 444 : NBRFAC=0 445 : SEGINI NOMID 446 : MOMATR=NOMID 447 : LESOBL(1)='YOUN' 448 : LESOBL(2)='V1X ' 449 : LESOBL(3)='V1Y ' 450 : ENDIF 451 : NMATR=NBROBL 452 : NMATF=NBRFAC 453 : ELSE 454 : $ IF (FORMOD(1).EQ.'MECANIQUE' 455 : $ .AND.CMATE.EQ.'ZONE_COHESIVE') THEN 456 : IF (MFR.EQ.77) THEN 457 : NBROBL=2 458 : NBRFAC=0 459 : SEGINI NOMID 460 : MOMATR=NOMID 461 : LESOBL(1)='KS ' 462 : LESOBL(2)='KN ' 463 : ENDIF 464 : NMATR=NBROBL 465 : NMATF=NBRFAC 466 : ELSE 467 : $ IF (FORMOD(1).EQ.'POREUX '.AND.CMATE.EQ.'ISOTROPE') THEN 468 : IF (MELE.GE.79.AND.MELE.LE.83) THEN 469 : NBROBL=4 470 : NBRFAC=0 471 : SEGINI NOMID 472 : MOMATR=NOMID 473 : LESOBL(1)='YOUN' 474 : LESOBL(2)='NU ' 475 : LESOBL(3)='COB ' 476 : LESOBL(4)='MOB ' 477 : ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN 478 : NBROBL=4 479 : NBRFAC=0 480 : SEGINI NOMID 481 : MOMATR=NOMID 482 : LESOBL(1)='KS ' 483 : LESOBL(2)='KN ' 484 : LESOBL(3)='COB ' 485 : LESOBL(4)='MOB ' 486 : ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN 487 : NBROBL=10 488 : NBRFAC=0 489 : SEGINI NOMID 490 : MOMATR=NOMID 491 : LESOBL(1)='YOUN' 492 : LESOBL(2)='NU ' 493 : LESOBL(3)='COP1' 494 : LESOBL(4)='COP2' 495 : LESOBL(5)='CPP1' 496 : LESOBL(6)='CPP2' 497 : LESOBL(7)='KK11' 498 : LESOBL(8)='KK12' 499 : LESOBL(9)='KK21' 500 : LESOBL(10)='KK22' 501 : ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN 502 : NBROBL=17 503 : NBRFAC=0 504 : SEGINI NOMID 505 : MOMATR=NOMID 506 : LESOBL(1)='YOUN' 507 : LESOBL(2)='NU ' 508 : LESOBL(3)='COP1' 509 : LESOBL(4)='COP2' 510 : LESOBL(5)='COP3' 511 : LESOBL(6)='CPP1' 512 : LESOBL(7)='CPP2' 513 : LESOBL(8)='CPP3' 514 : LESOBL(9)='KK11' 515 : LESOBL(10)='KK12' 516 : LESOBL(11)='KK13' 517 : LESOBL(12)='KK21' 518 : LESOBL(13)='KK22' 519 : LESOBL(14)='KK23' 520 : LESOBL(15)='KK31' 521 : LESOBL(16)='KK32' 522 : LESOBL(17)='KK33' 523 : ENDIF 524 : NMATR=NBROBL 525 : NMATF=NBRFAC 526 : * 527 : ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN 528 : NBROBL=6 529 : NBRFAC=0 530 : SEGINI NOMID 531 : MOMATR=NOMID 532 : LESOBL(1)='YG1 ' 533 : LESOBL(2)='YG2 ' 534 : LESOBL(3)='NU12' 535 : LESOBL(4)='G12 ' 536 : LESOBL(5)='V1X ' 537 : LESOBL(6)='V1Y ' 538 : NMATR=NBROBL 539 : NMATF=NBRFAC 540 : * 541 : * ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN 542 : * Pour l'instant, lnomid(6) ou appel a IDMATR suffisent. 543 : * 544 : ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN 544 : CALL IDDILI(MATE,1,MOMATR,NMATR,NMATF) 545 : nomid = momatr 546 : segact nomid 547 : * 548 : * Autres cas : 549 : ELSE 550 : if(lnomid(6).ne.0) then 551 : lsupma=.false. 552 : momatr = lnomid(6) 553 : else 553 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 554 : endif 555 : nomid = momatr 556 : segact nomid 557 : nmatr=lesobl(/2) 558 : nmatf=lesfac(/2) 559 : ENDIF 560 : * 561 : IF (CMATE.EQ.'SECTION') THEN 562 : NBTYPE=3 563 : SEGINI NOTYPE 564 : TYPE(1)='POINTEURMMODEL' 565 : TYPE(2)='POINTEURMCHAML' 566 : TYPE(3)='POINTEURLISTREEL' 567 : c mistral : 568 : ELSEIF (INAT.EQ.94) THEN 569 : NBTYPE=NMATR+NMATF 570 : SEGINI NOTYPE 571 : DO 11 ITYP=1,NBTYPE 572 : TYPE(ITYP)='REAL*8' 573 : 11 CONTINUE 574 : c pour le modטle mistral il y a 10 composantes non linיaires qui sont des listes de rיels 575 : NLDEB=NMATR-9 576 : DO 13 ITYP=NLDEB,NMATR 577 : TYPE(ITYP)='POINTEURLISTREEL' 578 : 13 CONTINUE 579 : c mistral. 580 : * 581 : * poi1 -- MODAL 582 : * 583 : ELSE IF (CMATE.EQ.'MODAL') THEN 584 : NBROBL=3 585 : NBRFAC=0 586 : SEGINI NOMID 587 : MOMATR=NOMID 588 : LESOBL(1)='FREQ' 589 : LESOBL(2)='MASS' 590 : LESOBL(3)='DEFO' 591 : * 592 : NBTYPE=3 593 : SEGINI NOTYPE 594 : MOTYPE=NOTYPE 595 : TYPE(1)='REAL*8' 596 : TYPE(2)='REAL*8' 597 : TYPE(3)='POINTEURCHPOINT' 598 : * 599 : * poi1 -- STATIQUE 600 : * 601 : ELSE IF (CMATE.EQ.'STATIQUE') THEN 602 : NBROBL=3 603 : NBRFAC=0 604 : SEGINI NOMID 605 : MOMATR=NOMID 606 : LESOBL(1)='DEFO' 607 : LESOBL(2)='RIDE' 608 : LESOBL(3)='MADE' 609 : * 610 : NBTYPE=1 611 : SEGINI NOTYPE 612 : MOTYPE=NOTYPE 613 : TYPE(1)='POINTEURCHPOINT' 614 : * 615 : * IMPEDANCE COMPLEXE 616 : * 617 : ELSE IF (CMATE.EQ.'IMPCOMPL') THEN 618 : NBROBL=1 619 : NBRFAC=0 620 : SEGINI NOMID 621 : MOMATR=NOMID 622 : LESOBL(1)='RAID' 623 : * 624 : NBTYPE=1 625 : SEGINI NOTYPE 626 : MOTYPE=NOTYPE 627 : TYPE(1)='REAL*8' 628 : * 629 : ELSE 630 : NBTYPE=1 631 : SEGINI NOTYPE 632 : TYPE(1)='REAL*8' 633 : ENDIF 634 : MOTYPE=NOTYPE 635 : * 635 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 636 : SEGSUP NOTYPE 637 : IF (IERR.NE.0) GOTO 9991 638 : NMATT=NMATR+NMATF 639 : IF(ISUP.EQ.1)THEN 639 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 640 : IF(IERR.NE.0)THEN 641 : ISUP=0 642 : GOTO 9991 643 : ENDIF 644 : ENDIF 645 : * 646 : MPTVAL=IVAMAT 647 : SEGACT,MPTVAL 648 : * 649 : if (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') then 649 : if (ival(/1).lt.3) call erreur(5) 650 : if (cmate.eq.'STATIQUE') then 651 : kstat = kstat + 1 652 : ivstat(kstat) = ivamat 653 : pistat(kstat) = imodel 654 : if (kstat.eq.nstat) then 655 : nstat = nstat + 100 656 : segadj modsta 657 : endif 658 : else if (cmate.eq.'MODAL') then 659 : kmoda = kmoda + 1 660 : ivmoda(kmoda) = ivamat 661 : pimoda(kmoda) = imodel 662 : if (kmoda.eq.nmoda) then 663 : nmoda = nmoda + 100 664 : segadj modsta 665 : endif 666 : endif 667 : endif 668 : * 669 : NBGMAT = 0 670 : NELMAT = 0 671 : DO 1108 IM=1,ival(/1) 672 : IF(IVAL(IM).NE.0)THEN 673 : MELVAL=IVAL(IM) 674 : IF (CMATE.EQ.'SECTION') THEN 675 : NBGMAT=MAX(NBGMAT,IELCHE(/1)) 676 : NELMAT=MAX(NELMAT,IELCHE(/2)) 677 : ELSE 678 : NBGMAT=MAX(NBGMAT,VELCHE(/1)) 679 : NELMAT=MAX(NELMAT,VELCHE(/2)) 680 : ENDIF 681 : ENDIF 682 : 1108 CONTINUE 683 : ENDIF 684 : * 685 : * >>> CHAMPS DE CARACTERISTIQUES 686 : * 687 : NBROBL=0 688 : NBRFAC=0 689 : MOCARA=0 690 : IVECT=0 691 : * 692 : * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES 693 : * 694 : IF((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.63.OR. 695 : + ((MELE.GE.79.AND.MELE.LE.83).OR. 696 : + (MELE.GE.173.AND.MELE.LE.182))) 697 : + .AND.IFOUR.EQ.-2)THEN 698 : NBROBL=0 699 : NBRFAC=1 700 : SEGINI NOMID 701 : MOCARA=NOMID 702 : LESFAC(1)='DIM3' 703 : * 704 : NBTYPE=1 705 : SEGINI NOTYPE 706 : MOTYPE=NOTYPE 707 : TYPE(1)='REAL*8' 708 : * 709 : * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES 710 : * 711 : ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 712 : NBROBL=1 713 : IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN 714 : NBRFAC=2 715 : ELSE 716 : NBRFAC=1 717 : ENDIF 718 : SEGINI NOMID 719 : MOCARA=NOMID 720 : LESOBL(1)='EPAI' 721 : LESFAC(1)='EXCE' 722 : IF(MFR.EQ.3.AND.IFOUR.EQ.-2) LESFAC(2)='DIM3' 723 : * 724 : NBTYPE=1 725 : SEGINI NOTYPE 726 : MOTYPE=NOTYPE 727 : TYPE(1)='REAL*8' 728 : * 729 : * SECTION POUR LES BARRES ET LES CERCES 730 : * 731 : ELSE IF (MFR.EQ.27) THEN 732 : IF(.NOT.dcmate) THEN 733 : NBROBL=1 734 : SEGINI NOMID 735 : MOCARA=NOMID 736 : LESOBL(1)='SECT' 737 : * 738 : NBTYPE=1 739 : SEGINI NOTYPE 740 : MOTYPE=NOTYPE 741 : TYPE(1)='REAL*8' 742 : ENDIF 743 : * 744 : * section, excentrements et orientation pour les barres excentrees 745 : * 746 : ELSE IF (MFR.EQ.49) THEN 747 : NBROBL=6 748 : SEGINI NOMID 749 : MOCARA=NOMID 750 : LESOBL(1)='SECT' 751 : LESOBL(2)='EXCZ' 752 : LESOBL(3)='EXCY' 753 : LESOBL(4)='VX ' 754 : LESOBL(5)='VY ' 755 : LESOBL(6)='VZ ' 756 : * 757 : NBTYPE=1 758 : SEGINI NOTYPE 759 : MOTYPE=NOTYPE 760 : TYPE(1)='REAL*8' 761 : * 762 : * raideurs locales et orientation pour l'element LIA2 763 : * de liaison a 2 noeuds 764 : * 765 : ELSE IF (MFR.EQ.51) THEN 766 : NBROBL=9 767 : SEGINI NOMID 768 : MOCARA=NOMID 769 : LESOBL(1)='RLUX' 770 : LESOBL(2)='RLUY' 771 : LESOBL(3)='RLUZ' 772 : LESOBL(4)='RLRX' 773 : LESOBL(5)='RLRY' 774 : LESOBL(6)='RLRZ' 775 : LESOBL(7)='VX ' 776 : LESOBL(8)='VY ' 777 : LESOBL(9)='VZ ' 778 : * 779 : NBTYPE=1 780 : SEGINI NOTYPE 781 : MOTYPE=NOTYPE 782 : TYPE(1)='REAL*8' 783 : * 784 : * CARACTERISTIQUES POUR LES POUTRES 785 : * 786 : ELSE IF (MFR.EQ.7 ) THEN 787 : if (dcmate) then 788 : NBROBL=0 789 : NBRFAC=4 790 : SEGINI NOMID 791 : MOCARA=NOMID 792 : LESFAC(1)='TORS' 793 : LESFAC(2)='INRY' 794 : LESFAC(3)='INRZ' 795 : LESFAC(4)='VECT' 796 : IVECT=1 797 : * 798 : NBTYPE=4 799 : SEGINI NOTYPE 800 : MOTYPE=NOTYPE 801 : TYPE(1)='REAL*8' 802 : TYPE(2)='REAL*8' 803 : TYPE(3)='REAL*8' 804 : TYPE(4)='POINTEURPOINT ' 805 : else 806 : IF (CMATE.EQ.'SECTION') THEN 807 : NBROBL=0 808 : NBRFAC=1 809 : SEGINI NOMID 810 : MOCARA=NOMID 811 : LESFAC='VECT' 812 : IVECT=1 813 : * 814 : NBTYPE=1 815 : SEGINI NOTYPE 816 : MOTYPE=NOTYPE 817 : TYPE(1)='POINTEURPOINT ' 818 : * 819 : * CAS 2D 820 : ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN 821 : NBRFAC=1 822 : NBROBL=2 823 : SEGINI NOMID 824 : MOCARA=NOMID 825 : LESOBL(1)= 'SECT' 826 : LESOBL(2)= 'INRZ' 827 : LESFAC(1)= 'SECY' 828 : * 829 : NBTYPE=1 830 : SEGINI NOTYPE 831 : MOTYPE=NOTYPE 832 : TYPE(1)='REAL*8' 833 : * 834 : ELSE 835 : NBROBL=4 836 : NBRFAC=3 837 : SEGINI NOMID 838 : MOCARA=NOMID 839 : LESOBL(1)='TORS' 840 : LESOBL(2)='INRY' 841 : LESOBL(3)='INRZ' 842 : LESOBL(4)='SECT' 843 : LESFAC(1)='SECY' 844 : LESFAC(2)='SECZ' 845 : LESFAC(3)='VECT' 846 : IVECT=1 847 : * 848 : NBTYPE=7 849 : SEGINI NOTYPE 850 : MOTYPE=NOTYPE 851 : TYPE(1)='REAL*8' 852 : TYPE(2)='REAL*8' 853 : TYPE(3)='REAL*8' 854 : TYPE(4)='REAL*8' 855 : TYPE(5)='REAL*8' 856 : TYPE(6)='REAL*8' 857 : TYPE(7)='POINTEURPOINT ' 858 : ENDIF 859 : endif 860 : * 861 : * CARACTERISTIQUES POUR LES TUYAUX 862 : * 863 : ELSE IF (MFR.EQ.13) THEN 864 : NBROBL=2 865 : NBRFAC=4 866 : SEGINI NOMID 867 : MOCARA=NOMID 868 : LESOBL(1)='EPAI' 869 : LESOBL(2)='RAYO' 870 : LESFAC(1)='RACO' 871 : LESFAC(2)='PRES' 872 : LESFAC(3)='CISA' 873 : LESFAC(4)='VECT' 874 : IVECT=1 875 : * 876 : NBTYPE=6 877 : SEGINI NOTYPE 878 : MOTYPE=NOTYPE 879 : TYPE(1)='REAL*8' 880 : TYPE(2)='REAL*8' 881 : TYPE(3)='REAL*8' 882 : TYPE(4)='REAL*8' 883 : TYPE(5)='REAL*8' 884 : TYPE(6)='POINTEURPOINT ' 885 : * 886 : ELSE IF (MFR.EQ.39) THEN 887 : NBROBL=2 888 : NBRFAC=3 889 : SEGINI NOMID 890 : MOCARA=NOMID 891 : LESOBL(1)='EPAI' 892 : LESOBL(2)='RAYO' 893 : LESFAC(1)='RACO' 894 : LESFAC(2)='PRES' 895 : LESFAC(3)='VECT' 896 : IVECT=1 897 : * 898 : NBTYPE=5 899 : SEGINI NOTYPE 900 : MOTYPE=NOTYPE 901 : TYPE(1)='REAL*8' 902 : TYPE(2)='REAL*8' 903 : TYPE(3)='REAL*8' 904 : TYPE(4)='REAL*8' 905 : TYPE(5)='POINTEURPOINT ' 906 : * 907 : * CARACTERISTIQUES POUR LES LINESPRING 908 : * 909 : ELSE IF (MFR.EQ.15) THEN 910 : NBROBL=5 911 : SEGINI NOMID 912 : MOCARA=NOMID 913 : LESOBL(1)='EPAI' 914 : LESOBL(2)='FISS' 915 : LESOBL(3)='VX ' 916 : LESOBL(4)='VY ' 917 : LESOBL(5)='VZ ' 918 : * 919 : NBTYPE=1 920 : SEGINI NOTYPE 921 : MOTYPE=NOTYPE 922 : TYPE(1)='REAL*8' 923 : * 924 : * CARACTERISTIQUES POUR LES TUYAUX FISSURES 925 : * 926 : ELSE IF (MFR.EQ.17) THEN 927 : NBROBL=9 928 : SEGINI NOMID 929 : MOCARA=NOMID 930 : LESOBL(1)='RAYO' 931 : LESOBL(2)='EPAI' 932 : LESOBL(3)='VX ' 933 : LESOBL(4)='VY ' 934 : LESOBL(5)='VZ ' 935 : LESOBL(6)='VXF ' 936 : LESOBL(7)='VYF ' 937 : LESOBL(8)='VZF ' 938 : LESOBL(9)='ANGL' 939 : * 940 : NBTYPE=1 941 : SEGINI NOTYPE 942 : MOTYPE=NOTYPE 943 : TYPE(1)='REAL*8' 944 : * 945 : * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES 946 : * 947 : ELSE IF (MFR.EQ.37) THEN 948 : IF(IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) THEN 949 : NBROBL=5 950 : SEGINI NOMID 951 : MOCARA=NOMID 952 : LESOBL(1)='SCEL' 953 : LESOBL(2)='SFLU' 954 : LESOBL(3)='EPS ' 955 : LESOBL(4)='SECT' 956 : LESOBL(5)='INRZ ' 957 : ELSE 958 : NBROBL=3 959 : SEGINI NOMID 960 : MOCARA=NOMID 961 : LESOBL(1)='SCEL' 962 : LESOBL(2)='SFLU' 963 : LESOBL(3)='EPS ' 964 : ENDIF 965 : * 966 : NBTYPE=1 967 : SEGINI NOTYPE 968 : MOTYPE=NOTYPE 969 : TYPE(1)='REAL*8' 970 : * 971 : * CARACTERISTIQUES DE L'ELEMENT TUYAU ACOUSTIQUE 972 : * 973 : ELSE IF (MFR.EQ.41) THEN 974 : NBROBL=1 975 : NBRFAC=1 976 : SEGINI NOMID 977 : MOCARA=NOMID 978 : LESOBL(1)='RAYO' 979 : LESFAC(1)='RACO' 980 : * 981 : NBTYPE=1 982 : SEGINI NOTYPE 983 : MOTYPE=NOTYPE 984 : TYPE(1)='REAL*8' 985 : C 986 : C CARACTERISTIQUE POUR LES JOINTS GENE 987 : C 988 : ELSE IF (MFR.EQ.55) THEN 989 : CcPPj NBROBL=1 990 : CcPPj NBRFAC=0 991 : CcPPj SEGINI NOMID 992 : CcPPj MOCARA=NOMID 993 : CcPPj LESOBL(1)='EPAI' 994 : NBROBL=0 995 : NBRFAC=1 996 : SEGINI NOMID 997 : MOCARA=NOMID 998 : LESFAC(1)='EPAI' 999 : C 1000 : NBTYPE=1 1001 : SEGINI NOTYPE 1002 : MOTYPE=NOTYPE 1003 : TYPE(1)='REAL*8' 1004 : * 1005 : * CARACTERISTIQUE MACRO_EL (element CIFL) 1006 : * 1007 : ELSE IF (MFR.EQ.61)THEN 1008 : NBRFAC=0 1009 : NBROBL=2 1010 : SEGINI NOMID 1011 : MOCARA=NOMID 1012 : LESOBL(1)= 'SECT' 1013 : LESOBL(2)= 'INRZ' 1014 : * 1015 : NBTYPE=1 1016 : SEGINI NOTYPE 1017 : MOTYPE=NOTYPE 1018 : TYPE(1)='REAL*8' 1019 : * 1020 : ENDIF 1021 : * 1022 : * rendement kich 09/01 1023 : if (notype.le.0) then 1024 : nbtype = 0 1025 : segini notype 1026 : motype = notype 1027 : nbrobl = 0 1028 : nbrfac = 0 1029 : segini nomid 1030 : mocara = nomid 1031 : endif 1032 : 1033 : ifac = nbrfac 1034 : NCAR1=NBROBL + NBRFAC + 1 1035 : NBRFAC= nbrfac + 10 1036 : segadj nomid 1037 : lesfac(ifac + 1) = 'REND' 1038 : lesfac(ifac + 2) = 'W1X ' 1039 : lesfac(ifac + 3) = 'W1Y ' 1040 : lesfac(ifac + 4) = 'W1Z ' 1041 : lesfac(ifac + 5) = 'W2X ' 1042 : lesfac(ifac + 6) = 'W2Y ' 1043 : lesfac(ifac + 7) = 'W2Z ' 1044 : lesfac(ifac + 8) = 'REN1' 1045 : lesfac(ifac + 9) = 'REN2' 1046 : lesfac(ifac + 10) = 'REN3' 1047 : NCARA=NBROBL 1048 : NCARF=NBRFAC 1049 : NCARR=NCARA+NCARF 1050 : nbtype = nbtype + 1 1051 : segadj notype 1052 : type(nbtype) = 'REAL*8' 1053 : * 1054 : IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN 1054 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR) 1055 : SEGSUP NOTYPE 1056 : IF (IERR.NE.0) GOTO 9991 1057 : * 1058 : IF (ISUP.EQ.1) THEN 1058 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 1059 : IF(IERR.NE.0)THEN 1060 : ISUP=0 1061 : GOTO 9991 1062 : ENDIF 1063 : ENDIF 1064 : ELSE 1065 : SEGSUP NOTYPE 1066 : ENDIF 1067 : * 1068 : * utiliser la densite pour ponderer par la prop de phase 1069 : * write (6,*) ' rigi1 conmod ',conmod 1070 : IF (conmod(17:24).NE.' ') THEN 1071 : * rechercher le melval 1072 : iptm = 0 1073 : MCHELM = IPCHE1 1074 : segact MCHELM 1075 : do ima = 1,imache(/1) 1076 : * write (6,*) ' rigi1 ima imache imamod ',ima,imache,imamod 1077 : if (imache(ima).eq.imamod) then 1078 : mchaml = ichaml(ima) 1079 : segact mchaml 1080 : do ic = 1,nomche(/2) 1081 : * write (6,*) ' rigi1 ima ic nomche ',ima,ic,nomche 1082 : if (nomche(ic)(1:4).eq.conmod(17:20)) then 1083 : iptm = ielval (ic) 1084 : segdes mchaml 1085 : segdes mchelm 1086 : goto 20 1087 : endif 1088 : enddo 1089 : segdes mchaml 1090 : endif 1091 : enddo 1092 : segdes mchelm 1093 : * avertissement 1094 : 20 if (iptm.eq.0) 1095 : & write(6,*) ' proportion phase non trouvee ',conmod(17:24) 1096 : * ponderation 1097 : if (iptm.gt.0) then 1098 : if(ivacar.ne.0) then 1099 : mptval = ivacar 1100 : segact mptval*mod 1101 : if (ival(ncar1).gt.0) then 1102 : melva1 = ival(ncar1) 1103 : melva2 = iptm 1104 : segact melva1,melva2 1105 : n1ptel = max(melva1.velche(/1),melva2.velche(/1)) 1106 : n1el = max(melva1.velche(/2),melva2.velche(/2)) 1107 : n2ptel = melva1.ielche(/1) 1108 : n2el = melva1.ielche(/2) 1109 : segini melval 1110 : do jptel = 1,n1ptel 1111 : do jel = 1,n1el 1112 : i1 = min(jptel,melva1.velche(/1)) 1113 : j1 = min(jel,melva1.velche(/2)) 1114 : i2 = min(jptel,melva2.velche(/1)) 1115 : j2 = min(jel,melva2.velche(/2)) 1116 : velche(jptel,jel) = melva1.velche(i1,j1)*melva2.velche(i2,j2) 1117 : enddo 1118 : enddo 1119 : ival(ncar1) = melval 1120 : segdes melva1,melva2 1121 : else if (ival(ncar1+7).gt.0.or.ival(ncar1+8).gt.0.or. 1122 : & ival(ncar1+9).gt.0) then 1123 : else 1124 : ival(ncar1) = iptm 1125 : tyval(ncar1) = 'REAL*8' 1126 : melval = iptm 1127 : segact melval 1128 : endif 1129 : 1130 : endif 1131 : endif 1132 : ENDIF 1133 : C 1134 : C cas particuliers des XFEM 1135 : IF (MFR.EQ.63) GOTO 63 1136 : 1137 : *רררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר 1138 : * P H A S E 2 1139 : * 1140 : * PREPARATION DES OBJETS RESULTATS 1141 : * 1142 : *רררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר 1143 : * 1144 : MELEME=IPMAIL 1145 : SEGACT MELEME 1146 : * 1147 : * MODIFICATION DU MELEME POUR LE REMPLISSAGE DU SEGMENT DESCRIPTEUR 1148 : * 1149 : IF (ldpge.AND.MFR.NE.35.AND.MFR.NE.53) THEN 1150 : IPT3=meleme 1151 : SEGACT IPT3 1152 : NBELEM=NUM(/2) 1153 : NBNN=IPT3.NUM(/1)+1 1154 : NBREF=0 1155 : NBSOUS=0 1156 : SEGINI MELEME 1157 : DO 1007 I=1,NBELEM 1158 : DO 1008 J=1,NBNN-1 1159 : NUM(J,I)=IPT3.NUM(J,I) 1160 : 1008 CONTINUE 1161 : NUM(NBNN,I)=IIPDPG 1162 : 1007 CONTINUE 1163 : ITYPEL=28 1164 : ICOLOR=IPT3.ICOLOR 1165 : IPMADG=MELEME 1166 : SEGDES IPT3 1167 : ELSE 1168 : NBNN=NUM(/1) 1169 : NBELEM=NUM(/2) 1170 : ENDIF 1171 : 1172 : * RECHERCHE DES NOMS D'INCONNUES ET DES DUAUX 1173 : * 1174 : NLIGRP= LRE 1175 : NLIGRD= LRE 1176 : SEGINI DESCR 1177 : IPDSCR=DESCR 1178 : if(lnomid(1).ne.0) then 1179 : nomid=lnomid(1) 1180 : segact nomid 1181 : modepl=nomid 1182 : ndepl=lesobl(/2) 1183 : ndum=lesfac(/2) 1184 : lsupdp=.false. 1185 : else 1186 : lsupdp=.true. 1186 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEPL,NDUM) 1187 : endif 1188 : if(lnomid(2).ne.0) then 1189 : nomid=lnomid(2) 1190 : segact nomid 1191 : moforc=nomid 1192 : nforc=lesobl(/2) 1193 : lsupfo=.false. 1194 : else 1195 : lsupfo=.true. 1195 : CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NDUM) 1196 : endif 1197 : * 1198 : IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN 1198 : CALL ERREUR(5) 1199 : SEGSUP DESCR,MRIGID 1200 : SEGDES MMODEL,MELEME 1201 : RETURN 1202 : ENDIF 1203 : * 1204 : * REMPLISSAGE DU SEGMENT DESCRIPTEUR 1205 : * 1206 : IDDL=1 1207 : NCOMP=NDEPL 1208 : NBNNS=NBNN 1209 : IF (MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) THEN 1210 : NCOMP=NDEPL-IDECAP 1211 : ENDIF 1212 : IF (ldpge.AND.MFR.NE.35.AND.MFR.NE.53) THEN 1213 : NCOMP=NDEPL-NDPGE 1214 : NBNNS=NBNN-1 1215 : ENDIF 1216 : IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2 1217 : if (dcmat2) NCOMP = NDEPL/2 1218 : NOMID=MODEPL 1219 : SEGACT NOMID 1220 : NOMID=MOFORC 1221 : SEGACT NOMID 1222 : * 1223 : IF ((MFR.NE.61) .AND. (NBNNS*NCOMP .GT. NLIGRD)) THEN 1224 : * erreur dans les dimensions de DESCR 1225 : * le mode de calcul n'est pas correct 1225 : CALL ERREUR(717) 1226 : SEGSUP DESCR,MRIGID 1227 : SEGDES MMODEL,MELEME 1228 : RETURN 1229 : ENDIF 1230 : * 1231 : IF(MFR.EQ.61)THEN 1232 : DO IE1=1,3 1233 : NOELEP(IE1)=1 1234 : NOELEP(IE1+3)=3 1235 : ENDDO 1236 : NOELEP(7)=2 1237 : NOELEP(8)=2 1238 : * 1239 : DO IE1=1,LRE 1240 : NOELED(IE1)=NOELEP(IE1) 1241 : ENDDO 1242 : * 1243 : NOMID=MODEPL 1244 : DO IE1=1,3 1245 : LISINC(IE1)=LESOBL(IE1) 1246 : LISINC(IE1+3)=LESOBL(IE1) 1247 : ENDDO 1248 : LISINC(7)=LESOBL(4) 1249 : LISINC(8)=LESOBL(5) 1250 : * 1251 : NOMID=MOFORC 1252 : DO IE1=1,3 1253 : LISDUA(IE1)=LESOBL(IE1) 1254 : LISDUA(IE1+3)=LESOBL(IE1) 1255 : ENDDO 1256 : LISDUA(7)=LESOBL(4) 1257 : LISDUA(8)=LESOBL(5) 1258 : ELSE 1259 : * 1260 : NFAC=(3*NBNN-IPORE)/2 1261 : DO 1004 INOEUD=1,NBNNS 1262 : IF (MELE.GE.108.AND.MELE.LE.110.AND.INOEUD.GT.NFAC) 1263 : . GO TO 1004 1264 : DO 1005 ICOMP=1,NCOMP 1265 : NOMID=MODEPL 1266 : LISINC(IDDL)=LESOBL(ICOMP) 1267 : if (dcmat2) LISINC(IDDL)=LESOBL(IDDL) 1268 : NOMID=MOFORC 1269 : LISDUA(IDDL)=LESOBL(ICOMP) 1270 : if (dcmat2) LISDUA(IDDL)=LESOBL(IDDL) 1271 : NOELEP(IDDL)=INOEUD 1272 : NOELED(IDDL)=INOEUD 1273 : IDDL=IDDL+1 1274 : 1005 CONTINUE 1275 : 1004 CONTINUE 1276 : * 1277 : ENDIF 1278 : * 1279 : * CAS DE LA DEFORMATION PLANE GENERALISEE 1280 : * 1281 : IF (ldpge.AND.MFR.NE.35.AND.MFR.NE.53) THEN 1282 : DO 1006 ICOMP=(NDPGE-1),0,-1 1283 : NOMID=MODEPL 1284 : LISINC(IDDL)=LESOBL(NDEPL-ICOMP) 1285 : NOMID=MOFORC 1286 : LISDUA(IDDL)=LESOBL(NFORC-ICOMP) 1287 : NOELEP(IDDL)=NBNN 1288 : NOELED(IDDL)=NBNN 1289 : IDDL=IDDL+1 1290 : 1006 CONTINUE 1291 : ENDIF 1292 : * 1293 : * CAS DES MILIEUX POREUX 1294 : * POUR LA PRESSION ON MET D'ABORD LES SOMMETS 1295 : * 1296 : IF (MFR.EQ.33) THEN 1297 : DO 1104 INOEUD=1,NBSOM(IELE) 1298 : NOMID=MODEPL 1299 : LISINC(IDDL)=LESOBL(NDEPL) 1300 : NOMID=MOFORC 1301 : LISDUA(IDDL)=LESOBL(NDEPL) 1302 : NOELEP(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1) 1303 : NOELED(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1) 1304 : IDDL=IDDL+1 1305 : 1104 CONTINUE 1306 : * 1307 : IF (MELE.GE.79.AND.MELE.LE.83) THEN 1308 : * 1309 : DO 1105 INOEUD=1,NBNN 1310 : DO 1115 INSOM=1,NBSOM(IELE) 1311 : IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1105 1312 : 1115 CONTINUE 1313 : NOMID=MODEPL 1314 : LISINC(IDDL)=LESOBL(NDEPL) 1315 : NOMID=MOFORC 1316 : LISDUA(IDDL)=LESOBL(NDEPL) 1317 : NOELEP(IDDL)=INOEUD 1318 : NOELED(IDDL)=INOEUD 1319 : IDDL=IDDL+1 1320 : 1105 CONTINUE 1321 : * 1322 : ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN 1323 : * 1324 : DO 1109 INOEUD=NFAC+1,NBNN 1325 : NOMID=MODEPL 1326 : LISINC(IDDL)=LESOBL(NDEPL) 1327 : NOMID=MOFORC 1328 : LISDUA(IDDL)=LESOBL(NDEPL) 1329 : NOELEP(IDDL)=INOEUD 1330 : NOELED(IDDL)=INOEUD 1331 : IDDL=IDDL+1 1332 : 1109 CONTINUE 1333 : * 1334 : DO 1110 INOEUD=1,NFAC 1335 : DO 1111 INSOM=1,NBSOM(IELE) 1336 : IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1110 1337 : 1111 CONTINUE 1338 : NOMID=MODEPL 1339 : LISINC(IDDL)=LESOBL(NDEPL) 1340 : NOMID=MOFORC 1341 : LISDUA(IDDL)=LESOBL(NDEPL) 1342 : NOELEP(IDDL)=INOEUD 1343 : NOELED(IDDL)=INOEUD 1344 : IDDL=IDDL+1 1345 : 1110 CONTINUE 1346 : * 1347 : ENDIF 1348 : * 1349 : * 1350 : ELSE IF(MFR.EQ.57.OR.MFR.EQ.59) THEN 1351 : * 1352 : IF (MELE.GE.173.AND.MELE.LE.182) THEN 1353 : * 1354 : DO 1304 IPR=1,IDECAP 1355 : NDECAP = NDEPL-IDECAP+IPR 1356 : * 1357 : DO 1204 INOEUD=1,NBSOM(IELE) 1358 : NOMID=MODEPL 1359 : LISINC(IDDL)=LESOBL(NDECAP) 1360 : NOMID=MOFORC 1361 : LISDUA(IDDL)=LESOBL(NDECAP) 1362 : NOELEP(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1) 1363 : NOELED(IDDL)=IBSOM(NSPOS(IELE)+INOEUD-1) 1364 : IDDL=IDDL+1 1365 : 1204 CONTINUE 1366 : * 1367 : DO 1205 INOEUD=1,NBNN 1368 : DO 1215 INSOM=1,NBSOM(IELE) 1369 : IF(INOEUD.EQ.IBSOM(NSPOS(IELE)+INSOM-1)) GO TO 1205 1370 : 1215 CONTINUE 1371 : NOMID=MODEPL 1372 : LISINC(IDDL)=LESOBL(NDECAP) 1373 : NOMID=MOFORC 1374 : LISDUA(IDDL)=LESOBL(NDECAP) 1375 : NOELEP(IDDL)=INOEUD 1376 : NOELED(IDDL)=INOEUD 1377 : IDDL=IDDL+1 1378 : 1205 CONTINUE 1379 : 1304 CONTINUE 1380 : * 1381 : ENDIF 1382 : ENDIF 1383 : * 1384 : * CAS DES ELEMENT RACCORD 1385 : * 1386 : IF (MFR.EQ.19.OR.MFR.EQ.21) THEN 1386 : CALL IDDEPL(MFR+1000,IFOUR,MODPL,NDEPL,NDUM) 1386 : CALL IDFORC(MFR+1000,IFOUR,MOFRC,NFORC,NDUM) 1387 : NOMID=MODPL 1388 : SEGACT NOMID 1389 : NOMID=MOFRC 1390 : SEGACT NOMID 1391 : DO 1106 INOEUD=NBNNS+1,NBNN 1392 : DO 1107 ICOMP=1,NDEPL 1393 : NOMID=MODPL 1394 : LISINC(IDDL)=LESOBL(ICOMP) 1395 : NOMID=MOFRC 1396 : LISDUA(IDDL)=LESOBL(ICOMP) 1397 : NOELEP(IDDL)=INOEUD 1398 : NOELED(IDDL)=INOEUD 1399 : IDDL=IDDL+1 1400 : 1107 CONTINUE 1401 : 1106 CONTINUE 1402 : NOMID=MODPL 1403 : SEGsup NOMID 1404 : NOMID=MOFRC 1405 : SEGsup NOMID 1406 : ENDIF 1407 : * 1408 : NOMID=MODEPL 1409 : if(lsupdp)SEGsup NOMID 1410 : NOMID=MOFORC 1411 : if(lsupfo)SEGsup NOMID 1412 : SEGDES DESCR 1413 : * 1414 : * INITIALISATION DU SEGMENT XMATRI 1415 : * 1416 : NELRIG = NBELEM 1417 : NLIGRP=LRE 1418 : NLIGRD=LRE 1419 : SEGINI XMATRI 1420 : IPMATR=XMATRI 1421 : IF (ldpge.AND.MFR.NE.35.AND.MFR.NE.53) THEN 1422 : IRIGEL(1,ISOU)=IPMADG 1423 : ELSE 1424 : IRIGEL(1,ISOU)=meleme 1425 : ENDIF 1426 : IRIGEL(2,ISOU)=0 1427 : IRIGEL(3,ISOU)=IPDSCR 1428 : IRIGEL(4,ISOU)=IPMATR 1429 : IRIGEL(5,ISOU)=NIFOUR 1430 : IRIGEL(6,ISOU)=0 1431 : IRIGEL(7,ISOU)=0 1432 : IF(MFR.EQ.57.OR.MFR.EQ.59) THEN 1433 : IRIGEL(7,ISOU)=2 1434 : ENDIF 1435 : COERIG(ISOU)=1.D0 1436 : * 1437 : * rendement anisotrope kich 1438 : if(ivacar.ne.0) then 1439 : mptval = ivacar 1440 : if(ival(/1).ge.ncar1+9) then 1441 : if (ival(ncar1+7).gt.0.or.ival(ncar1+8).gt.0.or. 1442 : & ival(ncar1+9).gt.0) then 1443 : irigel(7,isou)=2 1444 : endif 1445 : endif 1446 : endif 1447 : * 1448 : IF (ldpge.AND.MFR.NE.35.AND.MFR.NE.53) THEN 1449 : SEGDES MELEME 1450 : MELEME=IPMAIL 1451 : SEGACT MELEME 1452 : NBNN=NUM(/1) 1453 : ENDIF 1454 : * 1455 : if (dcmate) goto 29 1456 : * 1457 : *רררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר 1458 : * P H A S E 3 1459 : * 1460 : * CALCUL DES RIGIDITES ELEMENTAIRES 1461 : * 1462 : *רררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר 1463 : * 1464 : * NUMERO DES ETIQUETTES : 1465 : * Les elements sont groupes comme suit : 1466 : * - massif,liquide 'surface libre' poreux ----------------------> r 1467 : * - coq3,dkt,coq4,coq8,coq2,dst --------------------------------> r 1468 : * - poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,jot3> r 1469 : * - joi4,joi2,poutre de timoschenko,joi3 1470 : * 1471 : IF (MELE.LE.100) 1472 : * CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9 1473 : & GOTO ( 99, 99, 99, 4, 99, 4, 99, 4, 99, 4, 99 1474 : * RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT 1475 : & , 12, 99, 4, 4, 4, 4, 12, 12, 99, 99, 99 1476 : * TET4 TE10 PYR5 PY13 COQ3 DKT POUT LISP FAC3 FAC4 FAC6 1477 : & , 4, 4, 4, 4, 27, 27, 29, 29, 99, 99, 99 1478 : * FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2 1479 : & , 99, 4, 4, 4, 4, 4, 4, 27, 29, 29, 27 1480 : * POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO 1481 : & , 29, 29, 12, 4, 27, 29, 99, 99, 4, 4, 12 1482 : * COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15 1483 : & , 27, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 1484 : * THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10 1485 : & , 99, 99, 4, 4, 4, 4, 99, 99, 99, 99, 99 1486 : * IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4 1487 : & , 99, 4, 4, 4, 4, 4, 29, 29, 29, 29, 29 1488 : * JOI6 JOI8 LISC TRIH DST LIC4 CERC TUYO LSE2 LITU HYT3 1489 : & , 99, 99, 99, 29, 27, 12, 29, 29, 29, 29, 99 1490 : * HYQ4 1491 : & , 99),MELE 1492 : IF (MELE.LE.200) 1493 : * HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8 1494 : & GOTO ( 99, 99, 99, 99, 99, 99, 99, 4, 4, 4 1495 : * POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13 1496 : & , 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 1497 : * PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8 1498 : & , 4, 29, 29, 29, 29, 29, 99, 99, 99, 99, 99 1499 : * PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3 1500 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 1501 : * TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126 1502 : & , 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99 1503 : * TE56 PY91 TRH6 ???? ???? ???? ???? ???? ???? ???? ???? 1504 : & , 99, 99, 29, 51, 51, 51, 51, 51, 51, 51, 51 1505 : * ???? ???? JCT3 JCI4 JGI2 JGT3 JGI4 ???? ???? ???? ???? 1506 : & , 51, 51, 29, 29, 29, 29, 29, 4, 4, 4, 4 1507 : * ???? ???? ???? ???? ???? ???? Q4RI Q8RI ???? ???? ???? 1508 : & , 4, 4, 4, 4, 4, 4, 4, 4, 51, 51, 51 1509 : * ???? ???? ???? ???? ???? M1D2 M1D3 ???? ???? ???? ???? 1510 : & , 51, 51, 51, 51, 51, 4, 4, 51, 51, 51, 51 1511 : * ???? ???? 1512 : & , 51, 51),MELE-100 1513 : IF (MELE.LE.300) 1514 : * ???? ???? ???? ???? ???? ???? ???? ???? ???? 1515 : & GOTO ( 51, 51, 51, 51, 51, 51, 51, 51, 51 1516 : * ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? 1517 : & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51 1518 : * ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? 1519 : & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51 1520 : * ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? 1521 : & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51 1522 : * ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? ???? 1523 : & , 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51 1524 : * ???? ???? ???? ???? MACR ???? SHB8 ???? ???? XQ4R XC8R 1525 : & , 51, 51, 51, 51, 29, 51, 29, 51, 51, 63, 63 1526 : * JOI1 ZCO2 ZCO3 ZCO4 1527 : & , 29, 29, 29, 29),MELE-200 1528 : C 1529 : 51 CONTINUE 1530 : 99 CONTINUE 1531 : MOTERR(1:4)=NOMTP(MELE) 1532 : MOTERR(9:12)='RIGI1' 1532 : CALL ERREUR(86) 1533 : GOTO 9990 1534 : C_______________________________________________________________________ 1535 : C 1536 : C massif, liquide, 'surface libre', poreux 1537 : C_______________________________________________________________________ 1538 : C 1539 : 4 CONTINUE 1540 : 1541 : IF (MFR .EQ. 71) THEN 1541 : CALL RIGELE (MATE,MELE,NBPGAU,NSTRS,LRE,IPMAIL,IPMINT,IVAMAT, 1542 : & NMATT, IPMATR) 1543 : ELSE IF (MFR .EQ. 73) THEN 1543 : CALL RIGDIF (MATE,MELE,NBPGAU,NSTRS,LRE,IPMAIL,IPMINT,IVAMAT, 1544 : & NMATT, IPMATR) 1545 : ELSE 1545 : CALL RIGI2 (MATE,MELE,IPMAIL,IPMINT,NBPGAU,LRE,NSTRS,IVAMAT, 1546 : & IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT,LHOOK,NMATT, 1547 : & IPORE,NDDL,IPMATR,IIPDPG,ncar1) 1548 : ENDIF 1549 : GOTO 9990 1550 : C_______________________________________________________________________ 1551 : C 1552 : C ELTS DE RACCORD LIQUIDE SOLIDE RAC2 RACO LIA3 LIA4 LICO LIC4 1553 : C PAS DE RIGIDITE 1554 : C_______________________________________________________________________ 1555 : C 1556 : 12 CONTINUE 1557 : * 1558 : * DO 3012 IB=1,NBELEM 1559 : * SEGINI XMATRI 1560 : * IMATTT(IB)=XMATRI 1561 : * SEGDES XMATRI 1562 : * 3012 CONTINUE 1563 : * SEGDES XMATRI 1564 : GOTO 9990 1565 : C_______________________________________________________________________ 1566 : C 1567 : C coq3,dkt,coq4,coq8,coq2,dst 1568 : C_______________________________________________________________________ 1569 : C 1570 : 27 CONTINUE 1570 : CALL RIGI3(MATE,MELE,IPMAIL,IPMINT,IPMIN1,NBPGAU,LRE,NSTRS, 1571 : & IVAMAT,IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT,LHOOK, 1572 : & NMATT,LW,NPINT,IPMATR,IIPDPG) 1573 : GOTO 9990 1574 : C_______________________________________________________________________ 1575 : C 1576 : C poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,joints 2-3D 1577 : C poutre de Timoschenko,point,joi1,zco2,zco3,zco4 1578 : C_______________________________________________________________________ 1579 : C 1580 : 29 CONTINUE 1580 : CALL RIGI4(MATE,MELE,IPMAIL,IPMINT,NBPGAU,LRE,NSTRS, 1581 : & IVAMAT,IVACAR,IVECT,CMATE,MFR,NBGMAT,NELMAT,IMAT, 1582 : & LHOOK,NMATT,(NCAR1 - 1),ISOUS,LW,IPORE,IPMATR,IIPDPG) 1583 : GOTO 9990 1584 : C 1585 : C----------------------------------------------------------------------- 1586 : C 1587 : C Element de type "Relations de conformites" 1588 : C_______________________________________________________________________ 1589 : C 1590 : 31 CONTINUE 1591 : MELEME=ipmail 1592 : SEGACT MELEME 1593 : C IF (ITYPEL.NE.22) GOTO 9990 1594 : IDEBUT = LCOLOR(ICOLOR(1)) - 3 1595 : C==================== 1596 : C *** SEGMENT XMATRI 1597 : C==================== 1598 : NLIGRD=NUM(/1) 1599 : NLIGRP=NLIGRD 1600 : NELRIG=NUM(/2) 1601 : SEGINI XMATRI 1602 : DO 34 I=1,NELRIG 1603 : RE(1,2,i)=-1. 1604 : RE(2,1,i)=-1. 1605 : DO 36 ICAZ=3,NLIGRD 1606 : RE(1,ICAZ,i)=XCOEFF(IDEBUT+ICAZ) 1607 : RE(ICAZ,1,i)=RE(1,ICAZ,i) 1608 : 36 CONTINUE 1609 : 34 CONTINUE 1610 : C==================== 1611 : C *** SEGMENT DESCR 1612 : C==================== 1613 : C* NLIGRD=NUM(/1) 1614 : C* NLIGRP=NLIGRD 1615 : * Petite verification sur le nom de la composante mise en relation 1616 : nomid1=lnomid(1) 1617 : segact nomid1 1618 : NEXIST=0 1619 : DO 33 I=1,LNOMDD 1620 : IF (NOMDD(I).EQ.nomid1.lesobl(1)) NEXIST = I 1621 : 33 CONTINUE 1622 : segdes nomid1 1623 : IF (NEXIST.EQ.0) THEN 1623 : CALL ERREUR(837) 1624 : GOTO 9990 1625 : ENDIF 1626 : SEGINI,DESCR 1627 : LISINC(1)='LX ' 1628 : LISDUA(1)='FLX ' 1629 : NOELEP(1)=1 1630 : NOELED(1)=1 1631 : DO 35 I=2,NLIGRD 1632 : LISINC(I)=NOMDD(NEXIST) 1633 : LISDUA(I)=NOMDU(NEXIST) 1634 : NOELEP(i)=i 1635 : NOELED(i)=i 1636 : 35 CONTINUE 1637 : SEGDES,DESCR 1638 : C==================== 1639 : C *** SEGMENT MRIGID 1640 : C==================== 1641 : C* ICHOLE=0 1642 : C* IMGEO1=0 1643 : C* IMGEO2=0 1644 : C* IFORIG=0 1645 : C* ISUPEQ=0 1646 : COERIG(isou)=1. 1647 : IRIGEL(1,isou)=IPMAIL 1648 : IRIGEL(2,isou)=0 1649 : IRIGEL(3,isou)=DESCR 1650 : IRIGEL(4,isou)=XMATRi 1651 : IRIGEL(5,isou)=0 1652 : IRIGEL(6,isou)=0 1653 : IRIGEL(7,isou)=0 1654 : IRIGEL(8,isou)=0 1655 : GOTO 9990 1656 : C 1657 : C_______________________________________________________________________ 1658 : C 1659 : C Elements de type XFEM (MFR=63) 1660 : C_______________________________________________________________________ 1661 : C Le sous programme RIGIXR gere les appels aux elements de type XFEM 1662 : C (imoxfem est le modele complet ou partitionne si necessaire) 1663 : * as 2009/11/30 : ajout de IMAT,NBGMAT,NELMAT en entrיe de RIGIXR 1664 : * Attention : ISOU peut etre modifie suite a appel a RIGIXR, ainsi que 1665 : * la dimension de MRIGID en parallele ! 1666 : C 1667 : 63 CONTINUE 1667 : CALL RIGIXR (ISOU ,IPOI6,imoxfem,IPINF, 1668 : $ IVAMAT,IVACAR,NMATT,CMATE,NCAR1,NBGMAT,NELMAT,IMAT,IRETER) 1669 : IF (IRETER.NE.0) RETURN 1670 : GO TO 9991 1671 : * 1672 : *רררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר 1673 : * P H A S E 4 1674 : * 1675 : * DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA 1676 : * 1677 : *רררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר 1678 : * 1679 : 9990 CONTINUE 1680 : SEGDES XMATRI 1681 : SEGDES MELEME 1682 : 9991 CONTINUE 1683 : IF (IERR.NE.0) GOTO 518 1684 : 505 continue 1685 : * 1686 : 518 CONTINUE 1687 : IF(ISUP.EQ.1)THEN 1688 : * write(*,*) 'DTMVAL(IVACAR,3) ou IVACAR=',IVACAR 1688 : CALL DTMVAL(IVACAR,3) 1689 : ELSE 1690 : * write(*,*) 'DTMVAL(IVACAR,1) ou IVACAR=',IVACAR 1690 : CALL DTMVAL(IVACAR,1) 1691 : ENDIF 1692 : * 1693 : if (cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE') goto 519 1694 : IF(ISUP.EQ.1.AND.IMAT.NE.2)THEN 1694 : CALL DTMVAL(IVAMAT,3) 1695 : * write(*,*) 'DTMVAL(IVACAR,3) ou IVACAR=',IVACAR 1696 : ELSE 1697 : * write(*,*) 'DTMVAL(IVACAR,1) ou IVACAR=',IVACAR 1697 : CALL DTMVAL(IVAMAT,1) 1698 : ENDIF 1699 : 519 continue 1700 : C 1701 : IF (MOCARA.NE.0)THEN 1702 : NOMID=MOCARA 1703 : SEGSUP NOMID 1704 : ENDIF 1705 : * 1706 : IF(MOMATR.NE.0)THEN 1707 : NOMID=MOMATR 1708 : if(lsupma)SEGSUP NOMID 1709 : ENDIF 1710 : * 1711 : IF (IPMINT.NE.0) SEGDES,MINTE 1712 : C 1713 : C DANS LE CAS D'ERREUR 1714 : C 1715 : IF(IERR.NE.0) THEN 1716 : IF(DESCR.NE.0)SEGSUP DESCR 1717 : IF(xMATRI.NE.0)SEGSUP xMATRI 1718 : GOTO 888 1719 : ENDIF 1720 : 500 CONTINUE 1721 : 1722 : if (isou.NE.irigel(/2)) then 1723 : nrigel=isou 1724 : segadj,MRIGID 1725 : endif 1726 : 1727 : *termes croises 'STATIQUE'/'MODAL' 1728 : nstat = kstat 1729 : nmoda = kmoda 1730 : segadj modsta 1731 : if (kstat.ne.0) then 1731 : if (nstat.gt.0.and.nstat+nmoda.gt.0) call ricroi(modsta, ir2,2) 1732 : if (nstat.gt.0) then 1733 : do kstat=1,nstat 1734 : mptval = ivstat(kstat) 1735 : segact mptval 1736 : IF(ISUP.EQ.1)THEN 1736 : CALL DTMVAL(mptval,3) 1737 : ELSE 1737 : CALL DTMVAL(mptval,1) 1738 : ENDIF 1739 : enddo 1740 : endif 1741 : if (nmoda.gt.0) then 1742 : do kmoda=1,nmoda 1743 : mptval = ivmoda(kmoda) 1744 : segact mptval 1745 : IF(ISUP.EQ.1)THEN 1745 : CALL DTMVAL(mptval,3) 1746 : ELSE 1746 : CALL DTMVAL(mptval,1) 1747 : ENDIF 1748 : enddo 1749 : endif 1750 : endif 1751 : if (nstat.gt.0.and.nstat+nmoda.gt.1) then 1752 : ir1 = mrigid 1752 : call fusrig(ir1,ir2,ir3) 1753 : if (ierr.ne.0) goto 888 1754 : mrigid = ir3 1755 : ipoi6 = mrigid 1756 : endif 1757 : 1758 : 888 CONTINUE 1759 : IF (IPCHE1.NE.0) THEN 1760 : MCHELM=IPCHE1 1761 : SEGDES MCHELM 1762 : ENDIF 1763 : IF (IPCHOO.NE.0) THEN 1764 : MCHELM=IPCHOO 1765 : SEGDES MCHELM 1766 : ENDIF 1767 : MRIGID = IPOI6 1768 : IF (IERR.NE.0) THEN 1769 : SEGSUP,MRIGID 1770 : IPOI6 = 0 1771 : IRET = 0 1772 : ELSE 1773 : SEGDES,MRIGID 1774 : IRET = 1 1775 : ENDIF 1776 : segsup modsta 1777 : 889 CONTINUE 1778 : MMODEL = IPMODL 1779 : DO i = 1, NSOUS 1780 : IMODEL = KMODEL(i) 1781 : SEGDES,IMODEL 1782 : ENDDO 1783 : SEGSUP,MMODEL 1784 : 1785 : RETURN 1786 : END 1787 : 1788 : 1789 : 1790 :
© Cast3M 2003 - All rights reserved.
Disclaimer