1 : C HOTANP SOURCE CHAT 11/03/16 21:24:56 6902 2 : SUBROUTINE HOTANP(IPMODL,IPCHE1,IPCHE2,IPCHE3,XPREC, 3 : & DTPS,IPCHOT,IRET) 4 : *_______________________________________________________________________ 5 : * 6 : * ENTREES : 7 : * --------- 8 : * 9 : * IPCHE1 pointeur sur le MCHAML de sous type CONTRAINTES 10 : * IPCHE2 pointeur sur le MCHAML de sous type VARIABLES INTERNES 11 : * IPCHE3 pointeur sur le MCHAML de sous type CARACTERISTIQUES 12 : * IPMODL pointeur sur l'objet de type MMODEL 13 : * XPREC flottant (par defaut 1.D-3) 14 : * DTPS flottant increment de temps pour les modèles visqueux 15 : * 16 : * SORTIES : 17 : * --------- 18 : * 19 : * IPCHOT pointeur sur le MCHAML de sous type MATRICE de HOOKE 20 : * TANGENTE 21 : * IRET 1 ou 0 suivant succes ou pas 22 : * 23 : * Passage aux nouveaux CHAMELEM par JM CAMPENON le 05/91 24 : * 25 : *_______________________________________________________________________ 26 : IMPLICIT INTEGER(I-N) 27 : IMPLICIT REAL*8(A-H,O-Z) 28 : * 29 : -INC CCOPTIO 30 : -INC CCHAMP 31 : -INC SMCHAML 32 : -INC SMELEME 33 : -INC SMCOORD 34 : -INC SMMODEL 35 : -INC SMINTE 36 : -INC SMLREEL 37 : * 38 : *- Nombre de points maximal pour stocker une courbe de traction 39 : PARAMETER (LTRAC=2*75) 40 : * 41 : SEGMENT WRK1 42 : REAL*8 DDHOOK(NSTRS,NSTRS) 43 : REAL*8 DDHOMU(NSTRS,NSTRS) 44 : ENDSEGMENT 45 : * 46 : SEGMENT MIDON1 47 : REAL*8 XMAT(NCXMAT) 48 : ENDSEGMENT 49 : * 50 : SEGMENT MIDON2 51 : REAL*8 VAR(NVART) 52 : ENDSEGMENT 53 : * 54 : SEGMENT MIDON3 55 : REAL*8 XCAR(NCART) 56 : ENDSEGMENT 57 : * 58 : DIMENSION TRAC(LTRAC) 59 : * 60 : SEGMENT NOTYPE 61 : CHARACTER*16 TYPE(NBTYPE) 62 : ENDSEGMENT 63 : * 64 : SEGMENT MPTVAL 65 : INTEGER IPOS(NS) ,NSOF(NS) 66 : INTEGER IVAL(NCOSOU) 67 : CHARACTER*16 TYVAL(NCOSOU) 68 : ENDSEGMENT 69 : * 70 : CHARACTER*8 CMATE 71 : CHARACTER*(NCONCH) CONM 72 : PARAMETER ( NINF=3 ) 73 : INTEGER INFOS(NINF) 74 : LOGICAL lsupva,lsupco 75 : * 76 : IRET = 0 77 : * 78 : NHRM=NIFOUR 79 : KERRE=0 80 : KPE =0 81 : * 82 : * Verification du lieu support du MCHAML de contraintes 83 : * 83 : CALL QUESUP(IPMODL,IPCHE1,3,0,ISUPCO,IRETCO) 84 : IF (ISUPCO.GT.1) RETURN 85 : * 86 : * Verification du lieu support du MCHAML de variables internes 87 : * 87 : CALL QUESUP(IPMODL,IPCHE2,3,0,ISUPVA,IRETVA) 88 : IF (ISUPVA.GT.1) RETURN 89 : * 90 : * Verification du lieu support du MCHAML de materiau 91 : * 91 : CALL QUESUP(IPMODL,IPCHE3,3,0,ISUPMA,IRETMA) 92 : IF (ISUPMA.GT.1) RETURN 93 : * 94 : * Activation du MMODEL 95 : * 96 : MMODEL=IPMODL 97 : SEGACT MMODEL 98 : NSOUS=KMODEL(/1) 99 : * 100 : * Creation du MCHELM de MATRICE DE HOOKE TANGENTE 101 : * 102 : N1=NSOUS 103 : L1=16 104 : N3=6 105 : SEGINI MCHELM 106 : IPCHOT=MCHELM 107 : TITCHE='MATRICE DE HOOKE' 108 : IFOCHE=IFOUR 109 : * 110 : * Boucle sur les sous zones du maillage 111 : * 112 : DO 100 ISOUS=1,NSOUS 113 : * 114 : * Traitement du modele 115 : * 116 : IPMOD1=KMODEL(ISOUS) 117 : IMODEL=IPMOD1 118 : SEGACT IMODEL 119 : IPMAIL=IMAMOD 120 : CONM =CONMOD 121 : IMACHE(ISOUS) = IPMAIL 122 : CONCHE(ISOUS) = CONMOD 123 : * 124 : MELE=NEFMOD 125 : MELEME=IMAMOD 126 : SEGACT MELEME 127 : NBNN=NUM(/1) 128 : NBELEM=NUM(/2) 129 : NFOR=FORMOD(/2) 130 : NMAT=MATMOD(/2) 131 : C 132 : C COQUE INTEGREE OU PAS ? 133 : C 134 : IF(INFMOD(/1).NE.0)THEN 135 : NPINT=INFMOD(1) 136 : ELSE 137 : NPINT=0 138 : ENDIF 139 : * 140 : * Nature du materiau 141 : * 141 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,MAPL) 142 : IF (CMATE.EQ.' ') THEN 142 : CALL ERREUR(251) 143 : SEGSUP MCHELM 144 : SEGDES MMODEL,IMODEL 145 : RETURN 146 : ENDIF 147 : * 148 : * Information sur l'element fini 149 : * 149 : * CALL ELQUOI(MELE,0,3,IPINF,IMODEL) 150 : * IF (IERR.NE.0) THEN 151 : * SEGDES IMODEL,MMODEL 152 : * SEGSUP MCHELM 153 : * RETURN 154 : * ENDIF 155 : MELE =INFELE(1) 156 : MFR =INFELE(13) 157 : IPPORE=0 158 : IF(MFR.EQ.33) IPPORE=NBNN 159 : NBG =INFELE(6) 160 : NBGS =INFELE(4) 161 : NSTRS=INFELE(16) 162 : LW =INFELE(7) 163 : LHOOK=INFELE(10) 164 : LHOO2=LHOOK*LHOOK 165 : ICARA=INFELE(5) 166 : * MINTE=INFELE(11) 167 : MINTE=INFMOD(5) 168 : IPMIN1=MINTE 169 : * 170 : * Creation du tableau INFOS ( contraintes et variables internes ) 171 : * 171 : CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,IRTD) 172 : IF (IRTD.EQ.0) THEN 173 : SEGDES IMODEL,MMODEL 174 : SEGSUP MCHELM 175 : RETURN 176 : ENDIF 177 : C 178 : INFCHE(ISOUS,1)=0 179 : INFCHE(ISOUS,2)=0 180 : INFCHE(ISOUS,3)=NHRM 181 : INFCHE(ISOUS,4)=MINTE 182 : INFCHE(ISOUS,5)=0 183 : INFCHE(ISOUS,6)=3 184 : * 185 : * Creation du MCHAML de HOOKE TANGENTE 186 : * 187 : N2=1 188 : SEGINI MCHAML 189 : ICHAML(ISOUS)=MCHAML 190 : NOMCHE(1)='MAHO' 191 : TYPCHE(1)='POINTEURLISTREEL' 192 : * 193 : IVAHOO=0 194 : WRK1=0 195 : MOCARA=0 196 : NCARA=0 197 : NCARF=0 198 : MOMATR=0 199 : NMATR=0 200 : NMATF=0 201 : MOVARI=0 202 : NVARI=0 203 : NVARF=0 204 : IVACAR=0 205 : IVAMAT=0 206 : IVARI=0 207 : IVACON=0 208 : C 209 : SEGACT,MINTE 210 : * 211 : * Traitement des champ de CONTRAINTES 212 : * 213 : if(lnomid(4).ne.0) then 214 : nomid=lnomid(4) 215 : segact nomid 216 : mocont=nomid 217 : nstrs=lesobl(/2) 218 : nfac=lesfac(/2) 219 : lsupco=.false. 220 : else 221 : lsupco=.true. 221 : CALL IDCONT(IMODEL,IFOUR,MOCONT,NSTRS,NFAC) 222 : endif 223 : IF (MOCONT.EQ.0) THEN 224 : MOTERR(1:4)='CONT' 225 : MOTERR(5:8)=NOMTP(MELE) 225 : CALL ERREUR (76) 226 : GOTO 9990 227 : ENDIF 228 : * 229 : NBTYPE=1 230 : SEGINI NOTYPE 231 : MOTYPE=NOTYPE 232 : TYPE(1)='REAL*8' 232 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCONT,MOTYPE,1,INFOS,3,IVACON) 233 : SEGSUP NOTYPE 234 : IF (IERR.NE.0) GOTO 9990 235 : * 236 : IF (ISUPCO.EQ.1) THEN 236 : CALL VALCHE(IVACON,NSTRS,IPMIN1,IPPORE) 237 : ENDIF 238 : * 239 : * Traitement des champ de VARIABLES INTERNES 240 : * 241 : if(lnomid(10).ne.0) then 242 : nomid=lnomid(10) 243 : segact nomid 244 : movari=nomid 245 : nvari=lesobl(/2) 246 : nvarf=lesfac(/2) 247 : lsupva=.false. 248 : else 249 : lsupva=.true. 249 : CALL IDVARI(MFR,IPMOD1,MOVARI,NVARI,NVARF) 250 : endif 251 : IF (MOVARI.EQ.0) THEN 252 : MOTERR(1:4)='VARI' 253 : MOTERR(5:8)=NOMTP(MELE) 253 : CALL ERREUR (76) 254 : GOTO 9990 255 : ENDIF 256 : NVART=NVARI+NVARF 257 : * 258 : NBTYPE=1 259 : SEGINI NOTYPE 260 : MOTYPE=NOTYPE 261 : TYPE(1)='REAL*8' 261 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI) 262 : SEGSUP NOTYPE 263 : IF (IERR.NE.0) GOTO 9990 264 : * 265 : IF (ISUPVA.EQ.1) THEN 265 : CALL VALCHE(IVARI,NVART,IPMIN1,IPPORE) 266 : ENDIF 267 : * 268 : * Creation du tableau INFOS (variables internes,caracteristiques) 269 : * 269 : CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE3,INFOS,IRTE) 270 : IF (IRTE.EQ.0) GOTO 9990 271 : * 272 : * Traitement des champs de materiaux 273 : * 274 : NBROBL=0 275 : NBRFAC=0 276 : IF (CMATE.EQ.'ISOTROPE') THEN 277 : IF (MAPL.EQ.1) THEN 278 : NBROBL=3 279 : SEGINI NOMID 280 : MOMATR=NOMID 281 : LESOBL(1)='YOUN' 282 : LESOBL(2)='NU ' 283 : LESOBL(3)='SIGY' 284 : * 285 : NBTYPE=1 286 : SEGINI NOTYPE 287 : MOTYPE=NOTYPE 288 : TYPE(1)='REAL*8' 289 : ELSE IF (MAPL.EQ.3) THEN 290 : NBROBL=4 291 : SEGINI NOMID 292 : MOMATR=NOMID 293 : LESOBL(1)='YOUN' 294 : LESOBL(2)='NU ' 295 : LESOBL(3)='LTR ' 296 : LESOBL(4)='LCS ' 297 : * 298 : NBTYPE=1 299 : SEGINI NOTYPE 300 : MOTYPE=NOTYPE 301 : TYPE(1)='REAL*8' 302 : ELSE IF (MAPL.EQ.15) THEN 303 : NBROBL=11 304 : SEGINI NOMID 305 : MOMATR=NOMID 306 : LESOBL(1)='YOUN' 307 : LESOBL(2)='NU ' 308 : LESOBL(3)='ETA ' 309 : LESOBL(4)='MU ' 310 : LESOBL(5)='KL ' 311 : LESOBL(6)='GAMM' 312 : LESOBL(7)='DELT' 313 : LESOBL(8)='ALFA' 314 : LESOBL(9)='BETA' 315 : LESOBL(10)='K ' 316 : LESOBL(11)='H ' 317 : * 318 : NBTYPE=1 319 : SEGINI NOTYPE 320 : MOTYPE=NOTYPE 321 : TYPE(1)='REAL*8' 322 : ELSE IF (MAPL.EQ.4) THEN 323 : NBROBL=4 324 : SEGINI NOMID 325 : MOMATR=NOMID 326 : LESOBL(1)='YOUN' 327 : LESOBL(2)='NU ' 328 : LESOBL(3)='SIGY' 329 : LESOBL(4)='H ' 330 : * 331 : NBTYPE=1 332 : SEGINI NOTYPE 333 : MOTYPE=NOTYPE 334 : TYPE(1)='REAL*8' 335 : ELSE IF (MAPL.EQ.5) THEN 336 : NBROBL=3 337 : SEGINI NOMID 338 : MOMATR=NOMID 339 : LESOBL(1)='YOUN' 340 : LESOBL(2)='NU ' 341 : LESOBL(3)='TRAC' 342 : * 343 : NBTYPE=3 344 : SEGINI NOTYPE 345 : MOTYPE=NOTYPE 346 : TYPE(1)='REAL*8' 347 : TYPE(2)='REAL*8' 348 : TYPE(3)='POINTEUREVOLUTIO' 349 : ELSE IF (MAPL.EQ.26) THEN 350 : NBROBL=3 351 : SEGINI NOMID 352 : MOMATR=NOMID 353 : LESOBL(1)='YOUN' 354 : LESOBL(2)='NU ' 355 : LESOBL(3)='DC ' 356 : * 357 : NBTYPE=1 358 : SEGINI NOTYPE 359 : MOTYPE=NOTYPE 360 : TYPE(1)='REAL*8' 361 : ELSE IF (MAPL.EQ.38) THEN 362 : * pour le modele de gurson l'option est indisponible 362 : CALL ERREUR (251) 363 : GOTO 9990 364 : * 365 : ELSE IF (MAPL.EQ.43) THEN 366 : * modele visco-plastique parfait 367 : NBROBL=5 368 : SEGINI NOMID 369 : MOMATR=NOMID 370 : LESOBL(1)='YOUN' 371 : LESOBL(2)='NU ' 372 : LESOBL(3)='SIGY' 373 : LESOBL(4)='N ' 374 : LESOBL(5)='K ' 375 : * 376 : NBTYPE=1 377 : SEGINI NOTYPE 378 : MOTYPE=NOTYPE 379 : TYPE(1)='REAL*8' 380 : ELSE 381 : NBROBL=2 382 : SEGINI NOMID 383 : MOMATR=NOMID 384 : LESOBL(1)='YOUN' 385 : LESOBL(2)='NU ' 386 : * 387 : NBTYPE=1 388 : SEGINI NOTYPE 389 : MOTYPE=NOTYPE 390 : TYPE(1)='REAL*8' 391 : ENDIF 392 : ELSE 393 : MOTERR(1:8)=NOMAT(MATE) 394 : MOTERR(9:12)=NOMAC(MAPL) 395 : MOTERR(13:20)=NOMFR(MFR) 396 : INTERR(1)=IFOUR 396 : CALL ERREUR(328) 397 : GOTO 9990 398 : ENDIF 399 : * 399 : CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 400 : SEGSUP NOTYPE 401 : IF (IERR.NE.0) GOTO 9990 402 : NMATR=NBROBL 403 : NMATF=NBRFAC 404 : NMATT=NMATR+NMATF 405 : IF(ISUPMA.EQ.1)THEN 405 : CALL VALCHE(IVAMAT,NMATT,IPMIN1,IPPORE) 406 : IF(IERR.NE.0)THEN 407 : ISUPMA=0 408 : GOTO 9990 409 : ENDIF 410 : ENDIF 411 : * 412 : NCXMAT=NMATT 413 : IF(MAPL.EQ.3) NCXMAT=NMATT+7 414 : * 415 : * Traitement des champs de caracteristiques 416 : * 417 : MOCARA = 0 418 : NBROBL = 0 419 : NBRFAC = 0 420 : IVECT = 0 421 : * 422 : * Cas des coques 423 : * 424 : IF (MFR.EQ.3) THEN 425 : IF(IFOCHE.GE.-2.OR.IFOCHE.LE.2) THEN 426 : NBROBL=2 427 : SEGINI NOMID 428 : MOCARA=NOMID 429 : LESOBL(1)='EPAI' 430 : LESOBL(2)='CALF' 431 : * 432 : NBTYPE=1 433 : SEGINI NOTYPE 434 : MOTYPE=NOTYPE 435 : TYPE(1)='REAL*8' 436 : ENDIF 437 : ENDIF 438 : * 439 : NCARA=NBROBL 440 : NCARF=NBRFAC 441 : NCART=NCARA+NCARF 442 : IF (MOCARA.NE.0) THEN 442 : CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR) 443 : SEGSUP,NOTYPE 444 : IF (IERR.NE.0) GOTO 9990 445 : * 446 : IF(ISUPMA.EQ.1)THEN 446 : CALL VALCHE(IVACAR,NCART,IPMIN1,IPPORE) 447 : IF(IERR.NE.0)THEN 448 : ISUPMA=0 449 : GOTO 9990 450 : ENDIF 451 : ENDIF 452 : SEGDES NOMID 453 : ENDIF 454 : * 455 : * Recherche de la taille des MELVALs a allouer 456 : * 457 : N2PTEL=NBG 458 : N2EL=NBELEM 459 : NEL=N2EL 460 : NBPTEL=N2PTEL 461 : * 462 : N1PTEL=0 463 : N1EL=0 464 : SEGINI MELVAL 465 : IVAHOO=MELVAL 466 : IELVAL(1)=MELVAL 467 : * 468 : * On met la courbe de traction a zero 469 : * 470 : SEGINI WRK1 470 : CALL ZDANUL(TRAC,LTRAC) 471 : * 472 : * DANS LE CAS DE COQUES INTEGREES ,ON LES TRAITE COMMME LE 473 : * MASSIF CONTRAINTE PLANE 474 : * 475 : IF(NPINT.NE.0)THEN 476 : IF(MELE.EQ.28)THEN 477 : IFOURB=-2 478 : MFR1=1 479 : ENDIF 480 : ELSE 481 : MFR1=MFR 482 : IFOURB=IFOUR 483 : ENDIF 484 : * 485 : * En cas de materiau endommageable 486 : * 487 : IF (MAPL.EQ.26.OR.MAPL.EQ.29) GOTO 555 488 : * 489 : * MFR= MASS COQU RAYL POUT CISTR LIQU TUYA LISP 490 : GOTO(1000,66,3000,66,66,66,66,66,66,66,66,66,66,66,66, 491 : * TUFI RAMA RACO SURF ICQ 492 : & 66,66,66,66,66,66,66,66,66,66,66,66,66,66,66,1000),MFR1 493 : 66 CONTINUE 494 : MOTERR(1:8)=NOMFR(MFR) 494 : CALL ERREUR(193) 495 : GOTO 9990 496 : *_______________________________________________________________________ 497 : * 498 : * Formulation MASSIVE 499 : *_______________________________________________________________________ 500 : * 501 : 1000 CONTINUE 502 : DO 1001 IB=1,NEL 503 : DO 1001 IGAU=1,NBPTEL 504 : * 505 : IF(MAPL.EQ.5) THEN 506 : MPTVAL=IVAMAT 507 : MELVAL=IVAL(1) 508 : IBMN=MIN(IB ,VELCHE(/2)) 509 : IGMN=MIN(IGAU,VELCHE(/1)) 510 : YYYY=VELCHE(IGMN,IBMN) 511 : * 512 : MELVAL=IVAL(3) 513 : IBMN=MIN(IB ,IELCHE(/2)) 514 : IGMN=MIN(IGAU,IELCHE(/1)) 515 : IMMM=IELCHE(IGMN,IBMN) 516 : * 516 : CALL COTRA1(IMMM,YYYY,LTRAC,TRAC,NTRAC,KERRE) 517 : IF(KERRE.NE.0) THEN 518 : KERIB=IB 519 : KERIG=IGAU 520 : ENDIF 521 : ENDIF 522 : * 522 : CALL DOHOT1(IVAMAT,NMATT,IVACON,NSTRS,IVARI,NVART,TRAC, 523 : & LTRAC,IGAU,IB,MATE,MAPL,XPREC,DTPS, 524 : & IFOURB,LHOOK,DDHOOK,IRTD) 525 : * 526 : IF(IRTD.EQ.-1) THEN 527 : KPE=-1 528 : KPEIB=IB 529 : KPEIG=IGAU 530 : ENDIF 531 : C 532 : JG=LHOO2 533 : SEGINI MLREEL 534 : MELVAL=IVAHOO 535 : IELCHE(IGAU,IB)=MLREEL 536 : KO=0 537 : DO 1005 IO=1,LHOOK 538 : DO 1005 JO=1,LHOOK 539 : KO=KO+1 540 : PROG(KO)=DDHOOK(IO,JO) 541 : 1005 CONTINUE 542 : C*// SEGDES MLREEL 543 : 1001 CONTINUE 544 : GOTO 510 545 : *_______________________________________________________________________ 546 : * 547 : * Cas des coques minces 548 : *_______________________________________________________________________ 549 : * 550 : 3000 CONTINUE 551 : DO 3001 IB=1,NEL 552 : DO 3001 IGAU=1,NBPTEL 553 : * 554 : IF(MAPL.EQ.5) THEN 555 : MPTVAL=IVAMAT 556 : * 557 : MELVAL=IVAL(1) 558 : IBMN=MIN(IB ,VELCHE(/2)) 559 : IGMN=MIN(IGAU,VELCHE(/1)) 560 : YYYY=VELCHE(IGMN,IBMN) 561 : * 562 : MELVAL=IVAL(3) 563 : IBMN=MIN(IB ,IELCHE(/2)) 564 : IGMN=MIN(IGAU,IELCHE(/1)) 565 : IMMM=IELCHE(IGMN,IBMN) 566 : * 566 : CALL COTRA1(IMMM,YYYY,LTRAC,TRAC,NTRAC,KERRE) 567 : IF(KERRE.NE.0) THEN 568 : KERIB=IB 569 : KERIG=IGAU 570 : ENDIF 571 : ENDIF 572 : * 573 : MPTVAL=IVACAR 574 : MELVAL=IVAL(1) 575 : IBMN=MIN(IB ,VELCHE(/2)) 576 : IGMN=MIN(IGAU,VELCHE(/1)) 577 : EPAIST=VELCHE(IGMN,IBMN) 578 : * 579 : MELVAL=IVAL(2) 580 : IBMN=MIN(IB ,VELCHE(/2)) 581 : IGMN=MIN(IGAU,VELCHE(/1)) 582 : ALPHA=VELCHE(IGMN,IBMN) 583 : * 584 : * DOHOT3 se chargera de convertir les efforts generalises (IVACON) 585 : * et les variables internes generalisees (IVARI) en contraintes et 586 : * variables internes "locales" 587 : * 587 : CALL DOHOT3(IVAMAT,NMATT,IVACON,NSTRS,IVARI,NVART, 588 : & TRAC,LTRAC,ALPHA,EPAIST,IGAU,IB,MATE,MAPL, 589 : & XPREC,DTPS,IFOURB,LHOOK,DDHOOK,IRTD) 590 : * 591 : IF(IRTD.EQ.-1) THEN 592 : KPE=-1 593 : KPEIB=IB 594 : KPEIG=IGAU 595 : ENDIF 596 : C 597 : JG=LHOO2 598 : SEGINI MLREEL 599 : MELVAL=IVAHOO 600 : IELCHE(IGAU,IB)=MLREEL 601 : KO=0 602 : DO 3014 IO=1,LHOOK 603 : DO 3014 JO=1,LHOOK 604 : KO=KO+1 605 : PROG(KO)=DDHOOK(IO,JO) 606 : 3014 CONTINUE 607 : C*// SEGDES MLREEL 608 : 3001 CONTINUE 609 : GOTO 510 610 : *_______________________________________________________________________ 611 : * 612 : * Cas des materiaux endommageables 613 : *_______________________________________________________________________ 614 : * 615 : 555 CONTINUE 616 : IF(MAPL.EQ.26) NMATT=NMATT+4 617 : NCXMAT=NMATT 618 : SEGINI MIDON1 619 : SEGINI MIDON2 620 : SEGINI MIDON3 621 : DO 2001 IB=1,NEL 622 : DO 2001 IGAU=1,NBPTEL 623 : * 624 : * On recupere les Cts du mat.,les var. int. et les carac. 625 : * 626 : MPTVAL=IVAMAT 627 : DO 2010 ICOMP=1,2 628 : MELVAL=IVAL(ICOMP) 629 : IBMN=MIN(IB ,VELCHE(/2)) 630 : IGMN=MIN(IGAU,VELCHE(/1)) 631 : XMAT(ICOMP)=VELCHE(IGMN,IBMN) 632 : 2010 CONTINUE 633 : C 634 : IF(MAPL.EQ.29) GOTO 2015 635 : C 636 : DO 2011 ICOMP=3,6 637 : XMAT(ICOMP)=0.D0 638 : 2011 CONTINUE 639 : MELVAL=IVAL(3) 640 : IBMN=MIN(IB ,VELCHE(/2)) 641 : IGMN=MIN(IGAU,VELCHE(/1)) 642 : XMAT(7)=VELCHE(IGMN,IBMN) 643 : * 644 : 2015 MPTVAL=IVARI 645 : DO 2020 ICOMP=1,NVART 646 : MELVAL=IVAL(ICOMP) 647 : IBMN=MIN(IB ,VELCHE(/2)) 648 : IGMN=MIN(IGAU,VELCHE(/1)) 649 : VAR(ICOMP)=VELCHE(IGMN,IBMN) 650 : 2020 CONTINUE 651 : * 652 : IF(MOCARA.NE.0) THEN 653 : MPTVAL=IVACAR 654 : DO 2030 ICOMP=1,NCART 655 : MELVAL=IVAL(ICOMP) 656 : IBMN=MIN(IB ,VELCHE(/2)) 657 : IGMN=MIN(IGAU,VELCHE(/1)) 658 : XCAR(ICOMP)=VELCHE(IGMN,IBMN) 659 : 2030 CONTINUE 660 : ENDIF 661 : * 662 : * Selon le modele de materiau endommageable 663 : * 664 : ZERO=0.D0 664 : IF (MAPL.EQ.26) CALL ELAST1(1,IFOURB,VAR,NVART,XMAT,NCXMAT, 665 : &ZERO,ZERO,XCAR,NCART,MFR1,NSTRS,DDHOOK,DDHOMU,KERRE,-1,0) 665 : IF (MAPL.EQ.29) CALL ELAST1(1,IFOURB,VAR,NVART,XMAT,NCXMAT, 666 : &ZERO,ZERO,XCAR,NCART,MFR1,NSTRS,DDHOOK,DDHOMU,KERRE,-2,0) 667 : IF (KERRE.NE.0) GOTO 66 668 : * 669 : * 670 : JG=LHOO2 671 : SEGINI MLREEL 672 : MELVAL=IVAHOO 673 : IELCHE(IGAU,IB)=MLREEL 674 : KO=0 675 : IF(NPINT.NE.0.AND.MFR.EQ.3)THEN 676 : DDHOOK(1,3)=DDHOOK(1,4) 677 : DDHOOK(2,3)=DDHOOK(2,4) 678 : DDHOOK(3,1)=DDHOOK(1,3) 679 : DDHOOK(3,2)=DDHOOK(2,3) 680 : DDHOOK(3,3)=DDHOOK(4,4) 681 : DO 2041 IO=1,LHOOK/2 682 : IO1=LHOOK*(IO-1) 683 : IO2=LHOOK*(2+IO) 684 : DO 2041 JO=1,LHOOK/2 685 : JO1=IO1+JO 686 : JO2=IO2+JO 687 : PROG(JO1)=DDHOOK(IO,JO) 688 : PROG(JO2+3)=DDHOOK(IO,JO) 689 : 2041 CONTINUE 690 : ELSE 691 : DO 2040 IO=1,LHOOK 692 : DO 2040 JO=1,LHOOK 693 : KO=KO+1 694 : PROG(KO)=DDHOOK(IO,JO) 695 : 2040 CONTINUE 696 : ENDIF 697 : C*// SEGDES MLREEL 698 : 2001 CONTINUE 699 : * 700 : SEGSUP MIDON1 701 : SEGSUP MIDON2 702 : SEGSUP MIDON3 703 : IF(MAPL.EQ.26) NMATT=NMATT-4 704 : 705 : GOTO 510 706 : *____________________________________________________________________* 707 : * * 708 : * DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS * 709 : *____________________________________________________________________* 710 : * * 711 : 510 CONTINUE 712 : * 713 : IF(MAPL.EQ.26.OR.MAPL.EQ.29) GOTO 110 714 : * 715 : * ERREUR le materiau n'est pas encore implente pour la 716 : * formulation MFR et l'option IFOUR 717 : * 718 : IF(IRTD.EQ.0) THEN 719 : MOTERR(1:8)=NOMAT(MATE) 720 : MOTERR(9:12)=NOMAC(MAPL) 721 : MOTERR(13:20)=NOMFR(MFR) 722 : INTERR(1)=IFOUR 722 : CALL ERREUR(328) 723 : GOTO 9990 724 : ENDIF 725 : * 726 : * Contraintes en dehors de la courbe de traction 727 : * 728 : IF(KPE.EQ.-1) THEN 729 : INTERR(1)=KPEIB 730 : INTERR(2)=KPEIG 731 : MOTERR(1:4)=NOMTP(MELE) 731 : CALL ERREUR(275) 732 : GOTO 9990 733 : ENDIF 734 : * 735 : * Probleme courbe de traction 736 : * 737 : IF(KERRE.NE.0) THEN 738 : INTERR(1)=KERIB 739 : INTERR(2)=KERIG 740 : MOTERR(1:4)=NOMTP(MELE) 740 : CALL ERREUR(KERRE) 741 : GOTO 9990 742 : ENDIF 743 : * 744 : 110 CONTINUE 745 : SEGDES MCHAML 746 : IF (IVAHOO.NE.0) THEN 747 : MELVAL=IVAHOO 748 : SEGDES MELVAL 749 : ENDIF 750 : * 751 : IF (ISUPMA.EQ.1) THEN 751 : CALL DTMVAL(IVAMAT,3) 752 : ELSE 752 : CALL DTMVAL(IVAMAT,1) 753 : ENDIF 754 : NOMID=MOMATR 755 : SEGSUP,NOMID 756 : * 757 : IF (ISUPMA.EQ.1) THEN 757 : CALL DTMVAL(IVACAR,3) 758 : ELSE 758 : CALL DTMVAL(IVACAR,1) 759 : ENDIF 760 : NOMID=MOCARA 761 : IF (MOCARA.NE.0) SEGSUP,NOMID 762 : * 763 : IF (ISUPVA.EQ.1) THEN 763 : CALL DTMVAL(IVARI,3) 764 : ELSE 764 : CALL DTMVAL(IVARI,1) 765 : ENDIF 766 : NOMID=MOVARI 767 : IF (lsupva) SEGSUP,NOMID 768 : * 769 : IF (ISUPCO.EQ.1) THEN 769 : CALL DTMVAL(IVACON,3) 770 : ELSE 770 : CALL DTMVAL(IVACON,1) 771 : ENDIF 772 : NOMID=MOCONT 773 : IF (lsupco) SEGSUP,NOMID 774 : * 775 : SEGDES,MINTE 776 : SEGDES IMODEL 777 : C*// SEGDES MELEME 778 : SEGSUP WRK1 779 : 100 CONTINUE 780 : IRET = 1 781 : SEGDES MMODEL,MCHELM 782 : RETURN 783 : * 784 : 9990 CONTINUE 785 : *_______________________________________________________________________ 786 : * 787 : * ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR 788 : *_______________________________________________________________________ 789 : * 790 : IRET = 0 791 : * 792 : IF (ISUPMA.EQ.1) THEN 792 : CALL DTMVAL(IVAMAT,3) 793 : ELSE 793 : CALL DTMVAL(IVAMAT,1) 794 : ENDIF 795 : NOMID=MOMATR 796 : SEGSUP,NOMID 797 : * 798 : IF (ISUPMA.EQ.1) THEN 798 : CALL DTMVAL(IVACAR,3) 799 : ELSE 799 : CALL DTMVAL(IVACAR,1) 800 : ENDIF 801 : NOMID=MOCARA 802 : IF (MOCARA.NE.0) SEGSUP,NOMID 803 : * 804 : IF (ISUPVA.EQ.1) THEN 804 : CALL DTMVAL(IVARI,3) 805 : ELSE 805 : CALL DTMVAL(IVARI,1) 806 : ENDIF 807 : NOMID=MOVARI 808 : IF (lsupva.AND.MOVARI.NE.0) SEGSUP,NOMID 809 : * 810 : IF (ISUPCO.EQ.1) THEN 810 : CALL DTMVAL(IVACON,3) 811 : ELSE 811 : CALL DTMVAL(IVACON,1) 812 : ENDIF 813 : NOMID=MOCONT 814 : IF (lsupco.AND.MOCONT.NE.0) SEGSUP,NOMID 815 : * 816 : IF (IVAHOO.NE.0) THEN 817 : MELVAL=IVAHOO 818 : SEGSUP MELVAL 819 : ENDIF 820 : IF (WRK1.NE.0) SEGSUP WRK1 821 : SEGDES,MINTE 822 : SEGDES MELEME 823 : SEGDES IMODEL 824 : SEGSUP MCHAML 825 : * 826 : SEGDES MMODEL 827 : SEGSUP MCHELM 828 : 829 : RETURN 830 : END 831 : 832 : 833 :
© Cast3M 2003 - All rights reserved.
Disclaimer