1 : C EPSI1 SOURCE AM 13/12/16 21:15:31 7825 2 : SUBROUTINE EPSI1(IREPS3,MODORI,IPCHP1,IPCHA1,IPCHA2, 3 : 1 IMAT,IPEPSI,IRET,ipchp2,noer,kerr) 4 : C_______________________________________________________________________ 5 : C 6 : C OPERATEUR DEFORMATIONS APPELE PAR EPSI 7 : C 8 : C ENTREES : 9 : C _________ 10 : C 11 : C MODORI POINTEUR SUR UN MMODEL 12 : C IPCHP1 POINTEUR SUR UN CHAMPOINT DEPLACEMENT 13 : C IPCHA1 POINTEUR SUR UN MCHAML DE CARACTERISTIQUE (FACULTATIF) 14 : C IPCHA2 POINTEUR SUR UN MCHAML DE HOOKE (FACULTATIF) 15 : C IMAT Flag de HOOKE (2 si oui, 1 sinon) 16 : C 17 : C SORTIES : 18 : C _________ 19 : C 20 : C IPEPSI POINTEUR SUR UN MCHAML DE DEFORMATION 21 : C IRET 1 OU 0 SUIVANT SUCCES OU PAS 22 : C 23 : C PASSAGE AUX NOUVEAUX CHAMELEMS PAR JM.CAMPENON LE 01.08.90 24 : C 25 : C----------------------------------------------------------------------- 26 : IMPLICIT INTEGER(I-N) 27 : IMPLICIT REAL*8(A-H,O-Z) 28 : 29 : -INC CCOPTIO 30 : -INC CCREEL 31 : -INC CCHAMP 32 : 33 : -INC SMCHAML 34 : -INC SMCHPOI 35 : -INC SMELEME 36 : -INC SMCOORD 37 : -INC SMMODEL 38 : -INC SMINTE 39 : -INC SMLREEL 40 : 41 : SEGMENT NOTYPE 42 : CHARACTER*16 TYPE(NBTYPE) 43 : ENDSEGMENT 44 : C 45 : SEGMENT MPTVAL 46 : INTEGER IPOS(NS),NSOF(NS) 47 : INTEGER IVAL(NCOSOU) 48 : CHARACTER*16 TYVAL(NCOSOU) 49 : ENDSEGMENT 50 : 51 : CHARACTER*8 CMATE 52 : CHARACTER*(NCONCH) CONM 53 : PARAMETER (NINF=3) 54 : INTEGER INFOS(NINF) 55 : LOGICAL BDPGE,ldpge,lsupde,lsupdp,lsupma,dcmate 56 : C 57 : IRET = 0 58 : IPEPSI = 0 59 : 60 : NHRM=NIFOUR 61 : C 62 : C ON VERIFIE QUE LE MCHAML DE CARACTERISTIQUE EST SUR SON SUPPORT 63 : C 64 : IF (IPCHA1.NE.0) THEN 64 : CALL QUESUP (MODORI,IPCHA1,5,0,ISUP1,IRET0) 65 : IF (ISUP1.GT.1) RETURN 66 : ENDIF 67 : C 68 : C ON VERIFIE QUE LE MCHAML DE HOOKE EST SUR SON SUPPORT 69 : C 70 : IF (IPCHA2.NE.0) THEN 70 : CALL QUESUP (MODORI,IPCHA2,5,1,ISUP2,IRET0) 71 : IF (ISUP2.NE.0) RETURN 72 : ENDIF 73 : C_______________________________________________________________________ 74 : C 75 : C ON CONVERTIT LE CHAMP POINT EN CHAMP PAR ELEMENT idem pour le 2eme 76 : C_______________________________________________________________________ 76 : CALL CHAME1 (0,MODORI,IPCHP1,' ',IPCH1,1) 77 : IF (IERR.NE.0) RETURN 78 : ipch2=0 78 : IF( ipchp2.ne.0)call CHAME1 (0,MODORI,IPCHP2,' ',IPCH2,1) 79 : C 80 : C ACTIVATION DU MODELE 81 : C 82 : * MODORI = Modele initial complet 83 : * IPMODL = Modele "deroule" (uniquement "MECANIQUE", "LIQUIDE" ou "POREUX") 83 : CALL PIMODL(MODORI,IPMODL) 84 : IF (IPMODL.EQ.0) RETURN 85 : * IPMODL est ACTIF en retour (nouveau pointeur pouvant etre detruit) 86 : MMODEL=IPMODL 87 : NSOUS = KMODEL(/1) 88 : C 89 : C CREATION DU MCHELM 90 : C 91 : KNB22=0 92 : DO IJKL=1,NSOUS 93 : IMODEL=KMODEL(IJKL) 94 : SEGACT IMODEL 95 : IF (NEFMOD.EQ.22) KNB22=KNB22+1 96 : END DO 97 : N1=NSOUS-KNB22 98 : L1=12 99 : N3=6 100 : SEGINI MCHELM 101 : TITCHE='DEFORMATIONS' 102 : IFOCHE=IFOUR 103 : 104 : C Initialisations de quelques variables 105 : IF (IFOUR.EQ.-3) THEN 106 : BDPGE=.TRUE. 107 : ELSE IF ((IFOUR.GE.7.AND.IFOUR.LE.11).OR.(IFOUR.EQ.14)) THEN 108 : BDPGE=.TRUE. 109 : ELSE 110 : BDPGE=.FALSE. 111 : ENDIF 112 : UZDPG=XZero 113 : RXDPG=XZero 114 : RYDPG=XZero 115 : C_______________________________________________________________________ 116 : C 117 : C DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES 118 : C 119 : C_______________________________________________________________________ 120 : C 121 : ISOUS=0 122 : DO 500 KISOUS=1,NSOUS 123 : * 124 : IMODEL=KMODEL(KISOUS) 125 : C* SEGACT IMODEL 126 : MELE=NEFMOD 127 : IF (MELE.EQ.22) GOTO 9992 128 : * 129 : ISOUS=ISOUS+1 130 : * 131 : * INITIALISATION 132 : * 133 : IVAMAT=0 134 : IVACAR=0 135 : IVADEP=0 136 : IVAEPS=0 137 : IPMINT=0 138 : MOMATR=0 139 : MOCARA=0 140 : MOEPSI=0 141 : MODEPL=0 142 : lsupma=.true. 143 : lsupde=.true. 144 : lsupdp=.true. 145 : dcmate = .false. 146 : C 147 : C ON RECUPERE L INFORMATION GENERALE 148 : C 149 : IIPDPG=IPDPGE 150 : IPMAIL=IMAMOD 151 : CONM =CONMOD 152 : IDERI=ideriv 153 : if( ireps3.eq.4) then 154 : ideri=1 155 : ireps2=0 156 : else 157 : if(ideriv.eq.2) then 158 : ireps2=1 159 : else 160 : ireps2=0 161 : endif 162 : endif 163 : C 164 : C CREATION DE TABLEAU INFOS 165 : C 165 : CALL IDENT(IPMAIL,CONM,IPCH1,IPCHA1,INFOS,IRTD) 166 : IF (IRTD.EQ.0) GOTO 9992 167 : C 168 : C TRAITEMENT DU MODELE 169 : C 170 : MELEME=IPMAIL 171 : IMACHE(ISOUS)=IPMAIL 172 : CONCHE(ISOUS)=CONMOD 173 : C 174 : C NATURE DU MATERIAU 175 : C 176 : * NFOR=FORMOD(/2) 177 : * NMAT=MATMOD(/2) 177 : * CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) 178 : CMATE = CMATEE 179 : MATE = IMATEE 180 : INAT = INATUU 181 : * IF (CMATE.EQ.' ')THEN 181 : * CALL ERREUR(251) 182 : * GOTO 9992 183 : * ENDIF 184 : do im = 1,matmod(/2) 185 : if (matmod(im).eq.'IMPEDANCE') dcmate =.true. 186 : enddo 187 : C_______________________________________________________________________ 188 : C 189 : C INFORMATION SUR L ELEMENT FINI 190 : C_______________________________________________________________________ 191 : C 192 : IF (INFMOD(/1).NE.0) THEN 193 : NPINT=INFMOD(1) 194 : ELSE 195 : NPINT=0 196 : ENDIF 196 : ** CALL ELQUOI(MELE,0,5,IPINF,IMODEL) 197 : ** IF (IERR.NE.0) GOTO 9992 198 : MFR =INFELE(13) 199 : IELE =INFELE(14) 200 : IPORE =INFELE(8) 201 : NBG =INFELE(6) 202 : NBGS =INFELE(4) 203 : NSTRS =INFELE(16) 204 : LRE =INFELE(9) 205 : LW =INFELE(7) 206 : LHOOK =INFELE(10) 207 : LHOO2 =LHOOK*LHOOK 208 : NDDL =INFELE(15) 209 : * MINTE =INFELE(11) 210 : MINTE=infmod(7) 211 : IPMINT=MINTE 212 : IPMIN1=INFMOD(8) 213 : C 214 : C ACTIVATION DE MELEME 215 : C 216 : SEGACT MELEME 217 : NBNN =NUM(/1) 218 : NBELEM=NUM(/2) 219 : IPPORE=0 220 : IF(MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) IPPORE=NBNN 221 : If((mfr.ne.1.and.ippore.ne.1).and.(ideri.eQ.3.or.ideri.eq.4))then 221 : call erreur (1013) 222 : return 223 : endif 224 : 225 : ldpge = BDPGE 226 : IF (MFR.EQ.71 .OR. MFR.EQ.73) ldpge = .FALSE. 227 : C 228 : C EXTRACTION DES DEPLACEMENTS DU NOEUD SUPPORT DE LA 229 : C DEFORMATION PLANE GENERALISEE (MECANIQUE) 230 : C 231 : IF (ldpge) THEN 231 : CALL DEPDPG(IPCHP1,UZDPG,RXDPG,RYDPG,IIPDPG) 232 : IF (IERR.NE.0) GOTO 9992 233 : ENDIF 234 : C 235 : INFCHE(ISOUS,1)=0 236 : INFCHE(ISOUS,2)=0 237 : INFCHE(ISOUS,3)=NHRM 238 : INFCHE(ISOUS,4)=IPMINT 239 : INFCHE(ISOUS,5)=0 240 : INFCHE(ISOUS,6)=5 241 : C 242 : C INITIALISATION DE MINTE 243 : C 244 : SEGACT MINTE 245 : NBPGAU=POIGAU(/1) 246 : C_______________________________________________________________________ 247 : C 248 : C RECHERCHE DES NOMS COMPOSANTES 249 : C_______________________________________________________________________ 250 : C 251 : if(lnomid(5).ne.0) then 252 : lsupde=.false. 253 : nomid=lnomid(5) 254 : segact nomid 255 : ndef=lesobl(/2) 256 : ndefac=lesfac(/2) 257 : moepsi=nomid 258 : else 258 : CALL IDDEFO(IMODEL,IFOUR,MOEPSI,NDEF,NDEFAC) 259 : endif 260 : C 261 : if(lnomid(1).ne.0) then 262 : lsupdp=.false. 263 : nomid=lnomid(1) 264 : segact nomid 265 : modepl=nomid 266 : ndep=lesobl(/2) 267 : nfac=lesfac(/2) 268 : else 268 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEP,NFAC) 269 : endif 270 : C 271 : C_______________________________________________________________________ 272 : C 273 : C VERIFICATION DE LEUR PRESENCE 274 : C_______________________________________________________________________ 275 : C 276 : NBTYPE=1 277 : SEGINI NOTYPE 278 : TYPE(1)='REAL*8' 279 : MOTYPE=NOTYPE 279 : CALL KOMCHA(IPCH1,IPMAIL,CONM,MODEPL,MOTYPE,1,INFOS,3,IVADEP) 280 : SEGSUP NOTYPE 281 : NOMID=MODEPL 282 : SEGDES,NOMID 283 : IF (IERR.NE.0) GOTO 9993 284 : IVADE2=0 285 : if( ipch2.ne.0) then 286 : C traitement du 2eme champs par point 287 : NBTYPE=1 288 : SEGINI NOTYPE 289 : TYPE(1)='REAL*8' 290 : MOTYPE=NOTYPE 290 : CALL KOMCHA(IPCH2,IPMAIL,CONM,MODEPL,MOTYPE,1,INFOS,3,IVADE2) 291 : SEGSUP NOTYPE 292 : IF (IERR.NE.0) GOTO 9993 293 : ENDIF 294 : C 295 : C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER 296 : C 297 : N1PTEL=0 298 : N1EL=0 299 : MPTVAL=IVADEP 300 : DO 110 I0=1,NDEP 301 : MELVAL=IVAL(I0) 302 : N1PTEL=MAX(N1PTEL,VELCHE(/1)) 303 : N1EL =MAX(N1EL,VELCHE(/2)) 304 : 110 CONTINUE 305 : IF (N1PTEL.EQ.1.OR.NBGS.EQ.1) THEN 306 : N1PTEL=1 307 : ELSE 308 : N1PTEL=NBGS 309 : ENDIF 310 : NBPTEL=N1PTEL 311 : NEL=N1EL 312 : C 313 : C CREATION DU MCHAML DE LA SOUS ZONE 314 : C 315 : if (ifomod.eq.6) then 316 : NSTRS = ndef + ndefac 317 : endif 318 : N2=NSTRS 319 : SEGINI MCHAML 320 : ICHAML(ISOUS)=MCHAML 321 : NS=1 322 : NCOSOU=NSTRS 323 : SEGINI MPTVAL 324 : IVAEPS=MPTVAL 325 : NOMID=MOEPSI 326 : SEGACT NOMID 327 : DO 100 ICOMP=1,NSTRS 328 : if (ifomod.eq.6) then 329 : if (icomp.le.ndef) then 330 : NOMCHE(ICOMP)=LESOBL(ICOMP) 331 : else 332 : NOMCHE(ICOMP)=LESFAC(ICOMP - ndef) 333 : endif 334 : else 335 : NOMCHE(ICOMP)=LESOBL(ICOMP) 336 : endif 337 : TYPCHE(ICOMP)='REAL*8' 338 : N2PTEL=0 339 : N2EL=0 340 : SEGINI MELVAL 341 : IELVAL(ICOMP)=MELVAL 342 : IVAL(ICOMP) =MELVAL 343 : 100 CONTINUE 344 : SEGDES NOMID 345 : C 346 : C en cas de derive de truesdell et de Jaumann il faudra calculer des 347 : C des contraintes donc on a besoin de la loi de hooke ou des 348 : C caracteristiques materiau ( young ...) 349 : C 350 : C____________________________________________________________________ 351 : C 352 : * RANGEMENT DE LA MATRICE DE HOOKE DANS UN TABLEAU DE TRAVAIL * 353 : C____________________________________________________________________ 354 : * 355 : IF( IDERI.EQ.3.or.ideri.eq.4) THEN 356 : IF(LNOMID(3).NE.0) then 357 : MOGRAD=LNOMID(3) 358 : NOMID=MOGRAD 359 : SEGACT,NOMID 360 : NGRA=LESOBL(/2) 361 : segdes nomid 362 : ELSE 362 : CALL IDGRAD(MDM,IFOUR,MOGRAD,NGRA,NFAC) 363 : NOMID=MOGRAD 364 : SEGACT,NOMID 365 : NGRA=LESOBL(/2) 366 : segdes nomid 367 : ENDIF 368 : if(lnomid(4).ne.0) then 369 : nomid=lnomid(4) 370 : segact nomid 371 : mostrs=nomid 372 : nstr=lesobl(/2) 373 : nfac=lesfac(/2) 374 : else 374 : CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC) 375 : endif 376 : nomid=mostrs 377 : segact nomid 378 : lsupma=.true. 379 : nbrobl=0 380 : nbrfac=0 381 : momatr=0 382 : IF (IMAT.EQ.2) THEN 383 : IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN 384 : NBROBL=3 385 : NBRFAC=0 386 : SEGINI NOMID 387 : LESOBL(1)='MAHO' 388 : LESOBL(2)='V1X ' 389 : LESOBL(3)='V1Y ' 390 : ELSE 391 : NBROBL=1 392 : NBRFAC=0 393 : SEGINI NOMID 394 : LESOBL(1)='MAHO' 395 : ENDIF 396 : MOMATR=NOMID 397 : NMATR=NBROBL 398 : NMATF=NBRFAC 399 : IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN 400 : NBTYPE=3 401 : SEGINI NOTYPE 402 : TYPE(1)='POINTEURLISTREEL' 403 : TYPE(2)='REAL*8' 404 : TYPE(3)='REAL*8' 405 : ELSE 406 : NBTYPE=1 407 : SEGINI NOTYPE 408 : TYPE(1)='POINTEURLISTREEL' 409 : ENDIF 410 : MOTYPE=NOTYPE 410 : CALL KOMCHA(IPCHA2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 411 : SEGSUP NOTYPE 412 : IF (IERR.NE.0) GOTO 9990 413 : MPTVAL=IVAMAT 414 : MELVAL=IVAL(1) 415 : NBGMAT=IELCHE(/1) 416 : NELMAT=IELCHE(/2) 417 : NMATT=NMATR+NMATF 418 : ELSE 419 : C____________________________________________________________________ 420 : * 421 : * SINON TRAITEMENT DES CHAMPS DE MATERIAU 422 : * aussi obligatoire en massifb pour truesdell et jaumann 423 : C____________________________________________________________________ 424 : * 425 : IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN 426 : NBROBL=2 427 : NBRFAC=0 428 : SEGINI NOMID 429 : MOMATR=NOMID 430 : IF (MFR.EQ.35) THEN 431 : LESOBL(1)='KS ' 432 : LESOBL(2)='KN ' 433 : ELSE IF(MFR.EQ.53) THEN 434 : NBROBL=1 435 : SEGADJ,NOMID 436 : LESOBL(1)='KS ' 437 : ELSE 438 : LESOBL(1)='YOUN' 439 : LESOBL(2)='NU ' 440 : ENDIF 441 : NMATR=NBROBL 442 : NMATF=NBRFAC 443 : ELSEIF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN 444 : IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN 445 : NBROBL=7 446 : NBRFAC=0 447 : SEGINI NOMID 448 : MOMATR=NOMID 449 : LESOBL(1)='YOUN' 450 : LESOBL(2)='V1X ' 451 : LESOBL(3)='V1Y ' 452 : LESOBL(4)='V1Z ' 453 : LESOBL(5)='V2X ' 454 : LESOBL(6)='V2Y ' 455 : LESOBL(7)='V2Z ' 456 : ELSE 457 : NBROBL=3 458 : NBRFAC=0 459 : SEGINI NOMID 460 : MOMATR=NOMID 461 : LESOBL(1)='YOUN' 462 : LESOBL(2)='V1X ' 463 : LESOBL(3)='V1Y ' 464 : ENDIF 465 : NMATR=NBROBL 466 : NMATF=NBRFAC 467 : ELSEIF (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 : * Autres cas : 540 : ELSE 541 : if(lnomid(6).ne.0) then 542 : nomid=lnomid(6) 543 : segact nomid 544 : momatr=nomid 545 : nmatr=lesobl(/2) 546 : nmatf=lesfac(/2) 547 : lsupma=.false. 548 : else 549 : lsupma=.true. 549 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 550 : endif 551 : ENDIF 552 : * 553 : * IF (CMATE.EQ.'SECTION') THEN 554 : * NBTYPE=3 555 : * SEGINI NOTYPE 556 : * TYPE(1)='POINTEURMMODEL' 557 : * TYPE(2)='POINTEURMCHAML' 558 : * TYPE(3)='POINTEURLISTREEL' 559 : * ELSE 560 : NBTYPE=1 561 : SEGINI NOTYPE 562 : TYPE(1)='REAL*8' 563 : * ENDIF 564 : MOTYPE=NOTYPE 565 : * 565 : CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 566 : SEGSUP NOTYPE 567 : IF (IERR.NE.0) GOTO 9990 568 : * 569 : NMATT=NMATR+NMATF 570 : * C 571 : IF(ISUP1.EQ.1)THEN 571 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 572 : IF(IERR.NE.0)THEN 573 : ISUP1=0 574 : GOTO 9990 575 : ENDIF 576 : ENDIF 577 : MPTVAL=IVAMAT 578 : NBGMAT = 0 579 : NELMAT = 0 580 : DO 11081 IM=1,NMATT 581 : IF(IVAL(IM).NE.0)THEN 582 : MELVAL=IVAL(IM) 583 : IF (CMATE.EQ.'SECTION') THEN 584 : NBGMAT=MAX(NBGMAT,IELCHE(/1)) 585 : NELMAT=MAX(NELMAT,IELCHE(/2)) 586 : ELSE 587 : NBGMAT=MAX(NBGMAT,VELCHE(/1)) 588 : NELMAT=MAX(NELMAT,VELCHE(/2)) 589 : ENDIF 590 : ENDIF 591 : 11081 CONTINUE 592 : ENDIF 593 : nmattd=nmatt 594 : ivamtd= ivamat 595 : ENDIF 596 : segdes nomid 597 : C_______________________________________________________________________ 598 : C 599 : C TRAITEMENT DES CHAMP CARACTERISTIQUES 600 : C_______________________________________________________________________ 601 : C 602 : NBROBL=0 603 : NBRFAC=0 604 : IVECT =0 605 : C 606 : C EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES 607 : C 608 : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 609 : NBROBL=1 610 : NBRFAC=1 611 : SEGINI NOMID 612 : MOCARA=NOMID 613 : LESOBL(1)='EPAI' 614 : LESFAC(1)='EXCE' 615 : * 616 : NBTYPE=1 617 : SEGINI NOTYPE 618 : TYPE(1)='REAL*8' 619 : C 620 : C SECTION POUR LES BARRES 621 : C 622 : ELSE IF (MFR.EQ.27) THEN 623 : IF(.NOT.dcmate) THEN 624 : 625 : NBROBL=1 626 : SEGINI NOMID 627 : MOCARA=NOMID 628 : LESOBL(1)='SECT' 629 : * 630 : NBTYPE=1 631 : SEGINI NOTYPE 632 : TYPE(1)='REAL*8' 633 : ENDIF 634 : * 635 : * section, excentrements et orientation pour les barres excentrees 636 : * 637 : ELSE IF (MFR.EQ.49) THEN 638 : NBROBL=6 639 : SEGINI NOMID 640 : MOCARA=NOMID 641 : LESOBL(1)='SECT' 642 : LESOBL(2)='EXCZ' 643 : LESOBL(3)='EXCY' 644 : LESOBL(4)='VX ' 645 : LESOBL(5)='VY ' 646 : LESOBL(6)='VZ ' 647 : * 648 : NBTYPE=1 649 : SEGINI NOTYPE 650 : TYPE(1)='REAL*8' 651 : * 652 : * raideurs locales et orientation pour l'element LIA2 653 : * de liaison a 2 noeuds 654 : * 655 : ELSE IF (MFR.EQ.51) THEN 656 : NBROBL=9 657 : SEGINI NOMID 658 : MOCARA=NOMID 659 : LESOBL(1)='RLUX' 660 : LESOBL(2)='RLUY' 661 : LESOBL(3)='RLUZ' 662 : LESOBL(4)='RLRX' 663 : LESOBL(5)='RLRY' 664 : LESOBL(6)='RLRZ' 665 : LESOBL(7)='VX ' 666 : LESOBL(8)='VY ' 667 : LESOBL(9)='VZ ' 668 : * 669 : NBTYPE=1 670 : SEGINI NOTYPE 671 : TYPE(1)='REAL*8' 672 : C 673 : C CARACTERISTIQUE POUR LES POUTRES 674 : C 675 : ELSE IF (MFR.EQ.7) THEN 676 : IF(.NOT.dcmate) THEN 677 : IF (CMATE.EQ.'SECTION') THEN 678 : NBROBL=0 679 : NBRFAC=1 680 : SEGINI NOMID 681 : MOCARA=NOMID 682 : LESFAC(1)='VECT' 683 : IVECT=1 684 : * 685 : NBTYPE=1 686 : SEGINI NOTYPE 687 : TYPE(1)='POINTEURPOINT ' 688 : ELSE 689 : IF(IFOUR.EQ.2) THEN 690 : NBROBL=4 691 : NBRFAC=3 692 : SEGINI NOMID 693 : MOCARA=NOMID 694 : LESOBL(1)='TORS' 695 : LESOBL(2)='INRY' 696 : LESOBL(3)='INRZ' 697 : LESOBL(4)='SECT' 698 : LESFAC(1)='SECY' 699 : LESFAC(2)='SECZ' 700 : LESFAC(3)='VECT' 701 : IVECT=1 702 : * 703 : NBTYPE=7 704 : SEGINI NOTYPE 705 : TYPE(1)='REAL*8' 706 : TYPE(2)='REAL*8' 707 : TYPE(3)='REAL*8' 708 : TYPE(4)='REAL*8' 709 : TYPE(5)='REAL*8' 710 : TYPE(6)='REAL*8' 711 : TYPE(7)='POINTEURPOINT ' 712 : ELSEIF(IFOUR.EQ.-1.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.63) THEN 713 : NBRFAC=1 714 : NBROBL=2 715 : SEGINI NOMID 716 : MOCARA=NOMID 717 : LESOBL(1)= 'SECT' 718 : LESOBL(2)= 'INRZ' 719 : LESFAC(1)= 'SECY' 720 : * 721 : NBTYPE=1 722 : SEGINI NOTYPE 723 : TYPE(1)='REAL*8' 724 : ENDIF 725 : ENDIF 726 : ENDIF 727 : C 728 : C TIMO 2D 729 : C 730 : * ELSE IF ((MFR.EQ.7).AND. 731 : * & (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3)) THEN 732 : * 733 : * IF (CMATE.NE.'SECTION') THEN 734 : * ENDIF 735 : C 736 : C CARACTERISTIQUE POUR LES TUYAUX 737 : C 738 : ELSE IF (MFR.EQ.13) THEN 739 : NBROBL=2 740 : NBRFAC=3 741 : SEGINI NOMID 742 : MOCARA=NOMID 743 : LESOBL(1)='EPAI' 744 : LESOBL(2)='RAYO' 745 : LESFAC(1)='RACO' 746 : LESFAC(2)='CISA' 747 : LESFAC(3)='VECT' 748 : IVECT=1 749 : C 750 : NBTYPE=5 751 : SEGINI NOTYPE 752 : TYPE(1)='REAL*8' 753 : TYPE(2)='REAL*8' 754 : TYPE(3)='REAL*8' 755 : TYPE(4)='REAL*8' 756 : TYPE(5)='POINTEURPOINT ' 757 : C 758 : C CARACTERISTIQUE POUR LES LINESPRING 759 : C 760 : ELSE IF (MFR.EQ.15) THEN 761 : NBROBL=5 762 : SEGINI NOMID 763 : MOCARA=NOMID 764 : LESOBL(1)='EPAI' 765 : LESOBL(2)='FISS' 766 : LESOBL(3)='VX ' 767 : LESOBL(4)='VY ' 768 : LESOBL(5)='VZ ' 769 : * 770 : NBTYPE=1 771 : SEGINI NOTYPE 772 : TYPE(1)='REAL*8' 773 : C 774 : C CARACTERISTIQUE POUR LES TUYAUX FISSURES 775 : C 776 : ELSE IF (MFR.EQ.17) THEN 777 : NBROBL=9 778 : SEGINI NOMID 779 : MOCARA=NOMID 780 : LESOBL(1)='RAYO' 781 : LESOBL(2)='EPAI' 782 : LESOBL(3)='VX ' 783 : LESOBL(4)='VY ' 784 : LESOBL(5)='VZ ' 785 : LESOBL(6)='VXF ' 786 : LESOBL(7)='VYF ' 787 : LESOBL(8)='VZF ' 788 : LESOBL(9)='ANGL' 789 : * 790 : NBTYPE=1 791 : SEGINI NOTYPE 792 : TYPE(1)='REAL*8' 793 : C 794 : C CARACTERISTIQUE POUR LES ELEMENTS HOMOGENEISES 795 : C 796 : ELSE IF (MFR.EQ.37) THEN 797 : IF (IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN 798 : NBROBL=4 799 : SEGINI NOMID 800 : MOCARA=NOMID 801 : LESOBL(1)='SCEL' 802 : LESOBL(2)='SFLU' 803 : LESOBL(3)='EPS ' 804 : LESOBL(4)='XINE' 805 : ELSE 806 : NBROBL=3 807 : SEGINI NOMID 808 : MOCARA=NOMID 809 : LESOBL(1)='SCEL' 810 : LESOBL(2)='SFLU' 811 : LESOBL(3)='EPS ' 812 : ENDIF 813 : * 814 : NBTYPE=1 815 : SEGINI NOTYPE 816 : TYPE(1)='REAL*8' 817 : C 818 : C CARACTERISTIQUE POUR LES JOINTS GENE 819 : C 820 : ELSE IF (MFR.EQ.55) THEN 821 : CcPPj NBROBL=1 822 : CcPPj NBRFAC=0 823 : CcPPj SEGINI NOMID 824 : CcPPj MOCARA=NOMID 825 : CcPPj LESOBL(1)='EPAI' 826 : NBROBL=0 827 : NBRFAC=1 828 : SEGINI NOMID 829 : MOCARA=NOMID 830 : LESFAC(1)='EPAI' 831 : C 832 : NBTYPE=1 833 : SEGINI NOTYPE 834 : TYPE(1)='REAL*8' 835 : C 836 : ENDIF 837 : C 838 : NCARA=NBROBL 839 : NCARF=NBRFAC 840 : NCARR=NCARA+NCARF 841 : C 842 : IF (MOCARA.NE.0) THEN 843 : IF (IPCHA1.EQ.0) THEN 844 : SEGSUP,NOTYPE 845 : MOTERR(1:8)='CARACTER' 846 : MOTERR(9:12)=NOMTP(MELE) 847 : MOTERR(13:20)='EPSI' 847 : CALL ERREUR(145) 848 : GOTO 9990 849 : ENDIF 850 : MOTYPE=NOTYPE 850 : CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS 851 : $ ,3,IVACAR) 852 : SEGSUP NOTYPE 853 : IF (IERR.NE.0) GOTO 9990 854 : IF (IVECT.EQ.1) THEN 855 : MPTVAL=IVACAR 856 : IF (IVAL(NCARR).EQ.0) THEN 857 : C 858 : C MOT CLE VECT EN CAS DE CONVERSION 859 : C 860 : segsup mptval 861 : IVECT=2 862 : NOMID=MOCARA 863 : C* SEGACT NOMID 864 : NBRFAC=NBRFAC+2 865 : SEGADJ NOMID 866 : LESFAC(NBRFAC-2)='VX ' 867 : LESFAC(NBRFAC-1)='VY ' 868 : LESFAC(NBRFAC) ='VZ ' 869 : C 870 : NCARF=NBRFAC 871 : NCARR=NCARA+NCARF 872 : C 873 : NBTYPE=1 874 : SEGINI,NOTYPE 875 : TYPE(1)='REAL*8' 876 : MOTYPE=NOTYPE 877 : * 877 : CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOCARA,MOTYPE, 878 : $ 1,INFOS,3,IVACAR) 879 : SEGSUP NOTYPE 880 : IF (IERR.NE.0) GOTO 9990 881 : ENDIF 882 : ENDIF 883 : SEGDES NOMID 884 : IF(ISUP1.EQ.1)THEN 884 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 885 : IF(IERR.NE.0)THEN 886 : ISUP1=0 887 : GOTO 9990 888 : ENDIF 889 : ENDIF 890 : ENDIF 891 : C____________________________________________________________________ 892 : C 893 : * RANGEMENT DE LA MATRICE DE HOOKE DANS UN TABLEAU DE TRAVAIL * 894 : * UNIQUEMENT DANS LE CAS DE L'ELEMENT COQUE DST 895 : C____________________________________________________________________ 896 : C 897 : NMATR=0 898 : NMATF=0 899 : NMATT=0 900 : NBGMAT=0 901 : NELMAT=0 902 : IF(MELE.EQ.93.and.INAT.EQ.2) THEN 903 : IF(CMATE.NE.'ISOTROPE')THEN 904 : NBROBL=3 905 : NBRFAC=0 906 : SEGINI NOMID 907 : LESOBL(1)='MAHO' 908 : LESOBL(2)='V1X ' 909 : LESOBL(3)='V1Y ' 910 : ELSE 911 : NBROBL=1 912 : NBRFAC=0 913 : SEGINI NOMID 914 : LESOBL(1)='MAHO' 915 : ENDIF 916 : MOMATR=NOMID 917 : NMATR=NBROBL 918 : NMATF=NBRFAC 919 : NMATT=NMATR+NMATF 920 : IF(CMATE.NE.'ISOTROPE')THEN 921 : NBTYPE=3 922 : SEGINI NOTYPE 923 : TYPE(1)='POINTEURLISTREEL' 924 : TYPE(2)='REAL*8' 925 : TYPE(3)='REAL*8' 926 : ELSE 927 : NBTYPE=1 928 : SEGINI NOTYPE 929 : TYPE(1)='POINTEURLISTREEL' 930 : ENDIF 931 : MOTYPE=NOTYPE 931 : CALL KOMCHA(IPCHA2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 932 : SEGSUP NOTYPE 933 : IF (IERR.NE.0) GOTO 9990 934 : MPTVAL=IVAMAT 935 : MELVAL=IVAL(1) 936 : NBGMAT=IELCHE(/1) 937 : NELMAT=IELCHE(/2) 938 : ENDIF 939 : C____________________________________________________________________ 940 : * 941 : * SINON TRAITEMENT DES CHAMPS DE MATERIAU 942 : C____________________________________________________________________ 943 : * 944 : IF((MELE.EQ.93.and.inat.ne.2).or. 945 : $ (mfr.eq.7.and.CMATE.NE.'SECTION'.and.(.not.dcmate)) 946 : $.or.mfr.eq.13)THEN 947 : IF ((FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') 948 : $ .or.mfr.eq.7) THEN 949 : NBROBL=2 950 : NBRFAC=0 951 : SEGINI NOMID 952 : MOMATR=NOMID 953 : LESOBL(1)='YOUN' 954 : LESOBL(2)='NU ' 955 : NMATR=NBROBL 956 : NMATF=NBRFAC 957 : ELSEIF(FORMOD(1).EQ.'MECANIQUE'.AND.(CMATE.EQ.'ORTHOTRO'))THEN 958 : IF(INAT.EQ.67) THEN 959 : NBROBL=6 960 : NBRFAC=0 961 : SEGINI NOMID 962 : MOMATR=NOMID 963 : LESOBL(1)='YG1 ' 964 : LESOBL(2)='YG2 ' 965 : LESOBL(3)='NU12' 966 : LESOBL(4)='G12 ' 967 : LESOBL(5)='V1X ' 968 : LESOBL(6)='V1Y ' 969 : NMATR=NBROBL 970 : NMATF=NBRFAC 971 : ELSE 972 : if(lnomid(6).ne.0) then 973 : lsupma=.false. 974 : nomid=lnomid(6) 975 : segact nomid 976 : momatr=nomid 977 : nmatr=lesobl(/2) 978 : nmatf=lesfac(/2) 979 : else 979 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 980 : nomid=MOMATR 981 : endif 982 : ENDIF 983 : ELSE 983 : CALL ERREUR(19) 984 : GOTO 9990 985 : ENDIF 986 : NMATT=NMATR+NMATF 987 : * 988 : NBTYPE=1 989 : SEGINI NOTYPE 990 : TYPE(1)='REAL*8' 991 : MOTYPE=NOTYPE 992 : * 992 : CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 993 : SEGSUP NOTYPE 994 : IF (IERR.NE.0) GOTO 9990 995 : * 996 : IF(ISUP1.EQ.1)THEN 996 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 997 : IF(IERR.NE.0)THEN 998 : ISUP1=0 999 : GOTO 9990 1000 : ENDIF 1001 : ENDIF 1002 : * 1003 : MPTVAL=IVAMAT 1004 : NBGMAT = 0 1005 : NELMAT = 0 1006 : DO 1108 IM=1,NMATT 1007 : IF(IVAL(IM).NE.0)THEN 1008 : MELVAL=IVAL(IM) 1009 : IF (CMATE.EQ.'SECTION') THEN 1010 : NBGMAT=MAX(NBGMAT,IELCHE(/1)) 1011 : NELMAT=MAX(NELMAT,IELCHE(/2)) 1012 : ELSE 1013 : NBGMAT=MAX(NBGMAT,VELCHE(/1)) 1014 : NELMAT=MAX(NELMAT,VELCHE(/2)) 1015 : ENDIF 1016 : ENDIF 1017 : 1108 CONTINUE 1018 : ENDIF 1019 : C================================================ 1020 : C 1021 : C CAS D'UN JOINT UNIDIMENSIONNEL JOI1 1022 : C Chargement des vecteurs situes dans les caracteristiques materiau 1023 : C 1024 : C================================================ 1025 : IF(MFR.EQ.75) THEN 1026 : IF(IDIM.EQ.3) THEN 1027 : NBROBL=6 1028 : NBRFAC=0 1029 : SEGINI NOMID 1030 : MOMATR=NOMID 1031 : LESOBL(1)='V1X' 1032 : LESOBL(2)='V1Y' 1033 : LESOBL(3)='V1Z' 1034 : LESOBL(4)='V2X' 1035 : LESOBL(5)='V2Y' 1036 : LESOBL(6)='V2Z' 1037 : NMATR=NBROBL 1038 : NMATF=NBRFAC 1039 : ELSE IF(IDIM.EQ.2) THEN 1040 : NBROBL=2 1041 : NBRFAC=0 1042 : SEGINI NOMID 1043 : MOMATR=NOMID 1044 : LESOBL(1)='V1X' 1045 : LESOBL(2)='V1Y' 1046 : NMATR=NBROBL 1047 : NMATF=NBRFAC 1048 : ENDIF 1049 : NBTYPE=1 1050 : SEGINI NOTYPE 1051 : TYPE(1)='REAL*8' 1052 : MOTYPE=NOTYPE 1053 : * 1053 : CALL KOMCHA(IPCHA1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 1054 : SEGSUP NOTYPE 1055 : IF (IERR.NE.0) GOTO 9990 1056 : * 1057 : NMATT=NMATR+NMATF 1058 : * C 1059 : IF(ISUP1.EQ.1)THEN 1059 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 1060 : IF(IERR.NE.0)THEN 1061 : ISUP1=0 1062 : GOTO 9990 1063 : ENDIF 1064 : ENDIF 1065 : MPTVAL=IVAMAT 1066 : NBGMAT = 0 1067 : NELMAT = 0 1068 : DO 11265 IM=1,NMATT 1069 : IF(IVAL(IM).NE.0)THEN 1070 : MELVAL=IVAL(IM) 1071 : IF (CMATE.EQ.'SECTION') THEN 1072 : NBGMAT=MAX(NBGMAT,IELCHE(/1)) 1073 : NELMAT=MAX(NELMAT,IELCHE(/2)) 1074 : ELSE 1075 : NBGMAT=MAX(NBGMAT,VELCHE(/1)) 1076 : NELMAT=MAX(NELMAT,VELCHE(/2)) 1077 : ENDIF 1078 : ENDIF 1079 : 11265 CONTINUE 1080 : nmattd=nmatt 1081 : ivamtd= ivamat 1082 : segdes nomid 1083 : ENDIF 1084 : C 1085 : if (dcmate) goto 29 1086 : C 1087 : C======================================================================= 1088 : C NUMERO DES ETIQUETTES : 1089 : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT 1090 : C ON DIRIGE DANS 3 SOUS-PROGRAMMES SELON LES ELEMENTS 1091 : C 1092 : C - massif, poreux, joints poreux ------------------> epsi2 1093 : C - coq3,dkt,coq4,coq8,coq2,joints -----------------> epsi3 1094 : C - poutre,tuyau,linespring,tuyau fissure,barre ----> epsi4 1095 : C - elements XFEM (mfr = 63) -----------------------> epsix 1096 : C 1097 : C======================================================================= 1098 : IF (MELE.LE.100) 1099 : &GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99, 1100 : 1 99,99, 4, 4, 4, 4,27,27,27,29,99,99,99,99,99,99,99,99,99,99, 1101 : 2 27,27,29,27,29,29,99,99,27,29,99,99,99,99,99,27,99,99,99,99, 1102 : 3 99,99,99,99,99,99,99,99, 4, 4, 4, 4,99,99,99,99,99,99, 4, 4, 1103 : 4 4, 4, 4,27,27,27,27,27,99,99,99,99,27,99,29,29,99,99,99,99 1104 : 5 ),MELE 1105 : IF (MELE.LE.200) 1106 : &GOTO (99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 1107 : 1 4, 4,29,29,29,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34, 1108 : 2 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34, 1109 : 3 34,34,34,34,34,34,34,27,27,27,27,27, 4, 4, 4, 4, 4, 4, 4, 4, 1110 : 4 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,34,34, 4, 4,34,34,34,34,34,34 1111 : 5 ),MELE-100 1112 : IF (MELE.LE.300) 1113 : &GOTO (34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34, 1114 : 1 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34, 1115 : 2 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,27,34,27, 1116 : 3 34,34,63,63,29,29,29,29),MELE-200 1117 : C 1118 : 34 CONTINUE 1119 : 99 CONTINUE 1120 : MOTERR(1:4) =NOMTP(MELE) 1121 : MOTERR(5:12)='EPSI' 1121 : CALL ERREUR(86) 1122 : GOTO 9990 1123 : C_______________________________________________________________________ 1124 : C 1125 : C massifs, poreux et joints poreux 1126 : C_______________________________________________________________________ 1127 : C 1128 : 4 CONTINUE 1128 : CALL EPSI2(IPMAIL,IPMINT,MELE,IELE, 1129 : & IVADEP,NBPTEL,LRE,NSTRS,LHOOK, 1130 : & MFR,NDEP,IPORE,IREPS2,NBPGAU,IVAEPS,UZDPG,RYDPG,RXDPG,IIPDPG, 1131 : & ideri,IVAMTD,ivade2,mate,nmattD,cmate,ngra,noer,kerr) 1132 : GOTO 9990 1133 : C_______________________________________________________________________ 1134 : C 1135 : C poutres,tuyau,coq3,dkt,coq4,coq8,coq2 ,dst,joint 3D,joints 2D 1136 : C_______________________________________________________________________ 1137 : C 1138 : 27 CONTINUE 1138 : CALL EPSI3(IPMAIL,IVADEP,IVACAR,NELMAT,NBGMAT,IVECT, 1139 : & IVAMAT,LHOOK,IMAT,MATE,CMATE,NMATT,NSTRS,MFR,IPMINT, 1140 : & NCARR,NDEP,NBPGAU,NBPTEL,MELE,LRE,LW,IREPS2,IVAEPS, 1141 : & IPMIN1,UZDPG,RYDPG,RXDPG,NPINT,IIPDPG) 1142 : GOTO 9990 1143 : C_______________________________________________________________________ 1144 : C 1145 : C linespring,tuyau fissure,barre,joi1,zone cohesive 1146 : C_______________________________________________________________________ 1147 : C 1148 : 29 CONTINUE 1148 : CALL EPSI4(IPMAIL,IVADEP,NDEP,IVAMAT,NMATT,IVACAR,NCARR,IPMINT, 1149 : & IVECT,MELE,LHOOK,IREPS2,NBPTEL,NSTRS,MFR, 1150 : & NBPGAU,LRE,LW,IVAEPS,UZDPG,RYDPG,RXDPG,ISOUS,IIPDPG,cmate) 1151 : GOTO 9990 1152 : C_______________________________________________________________________ 1153 : C 1154 : C Elements XFEM (MFR = 63) 1155 : C_______________________________________________________________________ 1156 : C 1157 : 63 CONTINUE 1157 : CALL EPSIX (IMODEL,IREPS2,IVADEP,IVAEPS, 1158 : & UZDPG,RYDPG,RXDPG,IIPDPG,IRETER) 1159 : IF (IRETER.NE.0) RETURN 1160 : GO TO 9990 1161 : C_______________________________________________________________________ 1162 : C 1163 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA 1164 : C_______________________________________________________________________ 1165 : C 1166 : 9990 CONTINUE 1167 : C 1168 : IF(IMAT.NE.2.AND.ISUP1.EQ.1)THEN 1168 : CALL DTMVAL(IVAMAT,3) 1169 : ELSE 1169 : CALL DTMVAL(IVAMAT,1) 1170 : ENDIF 1171 : C 1172 : IF(ISUP1.EQ.1)THEN 1172 : CALL DTMVAL(IVACAR,3) 1173 : ELSE 1173 : CALL DTMVAL(IVACAR,1) 1174 : ENDIF 1175 : C 1176 : IF(IERR.NE.0)THEN 1177 : SEGSUP MCHAML 1177 : CALL DTMVAL(IVAEPS,3) 1178 : ELSE 1179 : SEGDES MCHAML 1180 : mptval = ivaeps 1181 : do iv = 1, ival(/1) 1182 : ic1 = ival(iv) 1182 : call comred(ic1) 1183 : enddo 1183 : CALL DTMVAL(IVAEPS,1) 1184 : ENDIF 1185 : * 1186 : mptval = ivadep 1187 : do iv = 1, ival(/1) 1188 : ic1 = ival(iv) 1189 : * test pour les melval ?? 0 (=ceux des composantes facultatives et absentes) 1189 : if(ic1 .ne. 0) call comred(ic1) 1190 : enddo 1190 : CALL DTMVAL(IVADEP,1) 1190 : IF( IVADE2.NE.0) CALL DTMVAL(IVADE2,1) 1191 : * 1192 : 9993 CONTINUE 1193 : IF(MOMATR.NE.0)THEN 1194 : NOMID=MOMATR 1195 : if(lsupma)SEGSUP NOMID 1196 : ENDIF 1197 : * 1198 : IF(MOCARA.NE.0)THEN 1199 : NOMID=MOCARA 1200 : SEGSUP NOMID 1201 : ENDIF 1202 : * 1203 : IF(MOEPSI.NE.0)THEN 1204 : NOMID=MOEPSI 1205 : if(lsupde)SEGSUP NOMID 1206 : ENDIF 1207 : * 1208 : IF(MODEPL.NE.0)THEN 1209 : NOMID=MODEPL 1210 : if(lsupdp)SEGSUP NOMID 1211 : ENDIF 1212 : IF (IPMINT.NE.0) SEGDES,MINTE 1213 : SEGDES MELEME 1214 : 9992 CONTINUE 1215 : C 1216 : C DANS LE CAS D'ERREUR 1217 : C 1218 : IF (IERR.NE.0) GOTO 888 1219 : C 1220 : 500 CONTINUE 1221 : * 1222 : 888 CONTINUE 1223 : DO IJKL=1,NSOUS 1224 : IMODEL=KMODEL(IJKL) 1225 : SEGDES,IMODEL 1226 : ENDDO 1227 : SEGSUP,MMODEL 1228 : * 1229 : IF(IERR.NE.0)THEN 1230 : IRET = 0 1231 : SEGSUP MCHELM 1232 : IPEPSI = 0 1233 : ELSE 1234 : IRET = 1 1235 : SEGDES MCHELM 1236 : IPEPSI = MCHELM 1237 : ENDIF 1237 : CALL DTCHAM(IPCH1) 1238 : 1239 : RETURN 1240 : END 1241 : 1242 : 1243 : 1244 :
© Cast3M 2003 - All rights reserved.
Disclaimer