1 : C ECOU29 SOURCE CHAT 11/03/16 21:20:03 6902 2 : SUBROUTINE ECOU29(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR, 3 : 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET, 4 : 1 IVADS,IVAMAT,IVACAR, 5 : 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVARI,NMATT,NCARR, 6 : 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC, 7 : 4 N2EL,N2PTEL,NBNO,NBPGAU,LW,IVASTF,IVARIF,IVADEP,KERRE) 8 : *********************************************************************** 9 : * ecoulement inelastique appele par ecoul1 10 : c ppu modif pour les materiaux unidirectionels en plastique 11 : * MATERIAUX ENDOMMAGEABLES DE LEMAITRE 12 : *********************************************************************** 13 : * entrees : 14 : * 15 : * mate = numero de materiau elastique 16 : * inplas = numero de materiau inelastique 17 : * mele = numero element fini 18 : * ipmail = pointeur du maillage 19 : * nbptel = nombre de points par element 20 : * imat = pointeur sur un segment mptval de materiau (utilise par calsig) 21 : * icar = pointeur sur un segment mptval de caracteristiques 22 : * geometriques (utilise par calsig) 23 : * numat = nb de composantes du melval de imat 24 : * nucar = nb de composantes du melval de icar 25 : * ivastr =pointeur sur un segment mptval de contraintes 26 : * ivari =pointeur sur un segment mptval de variables internes 27 : * ivadef =pointeur sur un segment mptval de deformations 28 : * ivads =pointeur sur un segment mptval de contraintes (increments) 29 : * ivamat =pointeur sur un segment mptval de materiau 30 : * ivacar =pointeur sur un segment mptval de cacarteristiques geometrique 31 : * iph1 = pointeur sur un mchaml de temperatures au debut du pas 32 : * iph2 = pointeur sur un mchaml de temperatures a la fin du pas 33 : * iph3 = pointeur sur un mchaml de temperatures de reference 34 : * ithher = 0 si pas de chargement thermique 35 : * = 1 si chargement thermique mais materiau constant 36 : * = 2 si chargement thermique et mat. dependant de la temperature 37 : * ipch1,ipch2,ipch3,ithher ne servent que pour les materiaux 38 : * endommageables de lemaitre quand ils dependent de la temperature 39 : * lhook =taille de la matrice de hooke 40 : * nstrs =nombre de composantes de contraintes 41 : * nvari =nombre de composantes de variables internes 42 : * nmatt =nombre de composnates de proprietes de materiau 43 : * ncarr =nombre de composnates de caracteristiques geometriques 44 : * cmate =nom du materiau 45 : * precis =precision dans les iterations internes 46 : * jecher =0 ou 1 pour action dans ecoule 47 : * jnoid =0 ou 1 pour action dans ecoule 48 : * ipotab =pointeur sur segment table 49 : * istep =indicateur d'action pour calcul nonlocal 50 : * =0 dans le cas d'un calcul local (normal) 51 : * =1 ou 2 dans le cas d'un calcul nonlocal 52 : * =1 pour calcul des fonctions seuil uniquement 53 : * =2 pour calcul des variables dissipatives a partir 54 : * des fonctions seuil moyennees prealablement par nloc 55 : * 56 : * sorties : 57 : * ivastf =pointeur sur un segment mptval de contraintes 58 : * ivarif =pointeur sur un segment mptval de variables internes 59 : * ivadep =pointeur sur un segment mptval de deformations inelastiques 60 : * kerre =indicateur d'erreur 61 : * 62 : * p dowlatyari fev. 1992 63 : * 64 : * c. la borderie fev 92 restructuration et reecriture de certains 65 : * passages pour une meilleure lisibilite 66 : * 67 : * avril 92 ajout istep pour le non local 68 : * dec 92 modif pour poutres timoschenko 69 : * 70 : ************************************************************************ 71 : IMPLICIT INTEGER(I-N) 72 : IMPLICIT REAL*8(A-H,O-Z) 73 : * 74 : -INC CCOPTIO 75 : -INC SMCHAML 76 : -INC SMELEME 77 : -INC SMCOORD 78 : -INC SMMODEL 79 : -INC SMINTE 80 : -INC CCHAMP 81 : c======================================================================= 82 : c la variable kerre regit les impressions d erreurs dans plast 83 : c toutes erreurs de ecoule gerees dans ce sous programme 84 : c kerre=0 tout ok 85 : c de 1 a 6 s aligner sur valeurs donnees par ecoinc 86 : c = 7 un element tuyau a une epaisseur nulle 87 : c = 21 on ne trouve pas d intersection avec la surface de charge 88 : c = 22 sig0 a l exterieur de la surface de charge 89 : c 90 : c anomalies avec la courbe de traction 91 : c = 30 limite elastique nulle 92 : c = 31 trop de points 93 : c = 32 pas assez de points 94 : c = 33 pente incorrecte 95 : c = 34 module d'young nul 96 : c = 35 manque l'origine 97 : c = 36 pente a l'origine non egale a e 98 : c = 37 manque la courbe de traction 99 : c = 38 nu devrait etre nul 100 : c 101 : c = 48 donnees erronnees pour drucker-prager 102 : c = 49 matrice singuliere dans iter internes drucker-prager 103 : c = 51 pb dans drucker prager option non disponible 104 : c = 52 pb dans drucker prager donnees incompatibles 105 : c = 53 pb dans drucker prager solution impossible 106 : c = 54 les valeurs admissibles pour istep sont 0 1 ou 2 107 : c = 55 modele non implante en non local 108 : c = 56 probleme dans l'integration du modele mazars 109 : c = 57 .... 110 : c = 58 .... 111 : c = 59 .... 112 : c = 60 pb donnees du cam-clay 113 : c 114 : c = 99 cas non encore disponible 115 : c======================================================================= 116 : * 117 : SEGMENT MPTVAL 118 : INTEGER IPOS(NS) ,NSOF(NS) 119 : INTEGER IVAL(NCOSOU) 120 : CHARACTER*16 TYVAL(NCOSOU) 121 : ENDSEGMENT 122 : * 123 : SEGMENT WRK0 124 : REAL*8 XMAT(NCXMAT) 125 : ENDSEGMENT 126 : * 127 : SEGMENT WR00 128 : CHARACTER*16 TYMAT(NCXMAT) 129 : REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT) 130 : ENDSEGMENT 131 : * 132 : SEGMENT WRK1 133 : REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS) 134 : REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI) 135 : REAL*8 DEFP(NSTRS),XCAR(ICARA) 136 : ENDSEGMENT 137 : * 138 : SEGMENT WRK2 139 : REAL*8 TRAC(LTRAC) 140 : ENDSEGMENT 141 : * 142 : SEGMENT WRK22 143 : REAL*8 XXE(3,NBNN) 144 : ENDSEGMENT 145 : * 146 : SEGMENT WRK3 147 : REAL*8 WORK(LW),WORK2(LW2) 148 : ENDSEGMENT 149 : * 150 : SEGMENT WRK4 151 : REAL*8 XE(3,NBBB) 152 : ENDSEGMENT 153 : * 154 : SEGMENT WRK5 155 : REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS) 156 : ENDSEGMENT 157 : * 158 : SEGMENT WRK6 159 : REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS) 160 : REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS) 161 : REAL*8 SIGMA(NSTRS),SIGGD(NSTRS) 162 : ENDSEGMENT 163 : * 164 : SEGMENT WRK7 165 : REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB) 166 : ENDSEGMENT 167 : * 168 : SEGMENT WRK8 169 : REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS) 170 : ENDSEGMENT 171 : * 172 : SEGMENT WRK9 173 : REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX) 174 : REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1) 175 : REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO) 176 : REAL*8 SIGY(NSIGY) 177 : INTEGER NKX(NNKX) 178 : ENDSEGMENT 179 : * 180 : SEGMENT WR10 181 : INTEGER IABLO1(NTABO1) 182 : REAL*8 TABLO2(NTABO2) 183 : ENDSEGMENT 184 : * 185 : SEGMENT WR11 186 : INTEGER IABLO3(NTABO3) 187 : REAL*8 TABLO4(NTABO4) 188 : ENDSEGMENT 189 : * 190 : SEGMENT WTRAV 191 : REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT) 192 : REAL*8 VALCAR(NUCAR),DSIGT(NSTRS) 193 : REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK) 194 : REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM) 195 : REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK) 196 : ENDSEGMENT 197 : * 198 : SEGMENT WPOUT 199 : REAL*8 X(2),Y(2),Z(2) 200 : ENDSEGMENT 201 : * 202 : * Commun NECOU utilisé dans ECOINC 203 : * 204 : COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 205 : . ITYP,IFOURB,IFLUAG, 206 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 207 : . JFLUAG,KFLUAG,LFLUAG, 208 : . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 209 : * 210 : * Commun IECOU: sert de fourre-tout pour les initialisations 211 : * d'entiers 212 : * 213 : COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK, 214 : . NYALF1,NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND, 215 : . NSOM,NINV,NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT, 216 : . LTRAC,MFR,IELE,NHRM,NBNN,NBELEM,ICARA, 217 : . LW2,NDEF,NSTRSS,MFR1,NBGMAT,NELMAT,MSOUPA, 218 : . NUMAT1,LENDO,NBBB,NNVARI,KERR1,MELEME, 219 : . icou45,icou46,icou47,icou48,icou49,icou50, 220 : . icou51,icou52,icou53,icou54,icou55,icou56 221 : . icou57,icou58 222 : * 223 : * Commun XECOU: sert de fourre-tout pour les initialisations 224 : * de réels 225 : * 226 : COMMON/XECOU/DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP0 227 : * 228 : LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC 229 : LOGICAL LUNI1,LUNI2 230 : DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12) 231 : * 232 : CHARACTER*72 CHARRE 233 : CHARACTER*8 CMATE 234 : * 235 : * 236 : * mise à disposition des temperatures tini tfin tref 237 : * aux points de gauss 238 : * 239 : TETA1=-1.E35 240 : TETA2=-1.E35 241 : TETREF=-1.E35 242 : TREFA=-1.E35 243 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 244 : MCHAM3=IPH1 245 : MCHAM4=IPH2 246 : MCHAM5=IPH3 247 : SEGACT MCHAM3 248 : SEGACT MCHAM4 249 : SEGACT MCHAM5 250 : MELVA3=MCHAM3.IELVAL(1) 251 : MELVA4=MCHAM4.IELVAL(1) 252 : MELVA5=MCHAM5.IELVAL(1) 253 : SEGACT MELVA3 254 : SEGACT MELVA4 255 : SEGACT MELVA5 256 : ENDIF 257 : c 258 : c Initialisations de variables 259 : c--------------------------------- 260 : c - mise à zéro des variables du commun NECOU si besoin 261 : c - modèles viscoplastiques: 262 : c . on récupère le pas de temps 263 : c . on récupère le nombre maximal de sous-pas 264 : c . on met IND=1 265 : c - initialisation des dimensions des tableaux des segments 266 : c Sorties: en plus du commun NECOU, on range les autres données 267 : c initialisées dans les COMMON IECOU et XECOU 268 : c Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme 269 : c argument de DEFINI 270 : c 270 : CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE, 271 : . ISTEP,INPLAS,NPINT,IPOTAB,IVADEF, 272 : . IPMAIL,IVAMAT, 273 : . ITHHER,NUMAT,NUCAR,LOGVIS, 274 : . LUNI1,LUNI2,LW,KERRE) 275 : IF (KERRE.EQ.999) RETURN 276 : c 277 : c Initialisations des segments de travail 278 : c 279 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 280 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 281 : 1 .OR.MFR.EQ.33)) THEN 281 : CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1) 282 : MINTE2=IPTR1 283 : SEGACT MINTE2 284 : SEGINI WRK22 285 : ENDIF 286 : c 287 : IF (LOGVIS) SEGINI WRK8 288 : * 289 : * initialisation des segments de travail 290 : * 291 : SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5 292 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN 293 : SEGINI WRK4 294 : ENDIF 295 : IF(INPLAS.EQ.26)THEN 296 : SEGINI WRK6 297 : ENDIF 298 : c 299 : SEGINI WTRAV 300 : * 301 : * 302 : * boucle sur les elements 303 : * 304 : DO 1000 IB=1,NBELEM 305 : * 306 : * Matériaux orthotropes, anisotropes et unidirectionnels 307 : * en formulation massive: 308 : * - on cherche les coordonnees des noeuds de l element ib 309 : * - calcul des axes locaux 310 : * Cas particulier de l'ACIER_UNI 311 : * 311 : CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1, 312 : . MELEME,WRK4,WRK22,WTRAV) 313 : * 314 : * 315 : * boucle sur les points de gauss 316 : * 317 : DO 1100 IGAU=1,NBPTEL 318 : 319 : * 320 : * -recuperation de valmat et de valcar 321 : * -on recupere les contraintes initiales 322 : * -on recupere les variables internes 323 : * -on recupere les deformations inelastiques initiales si besoin 324 : * -on recupere les increments de deformations totales 325 : * -on cherche la section de l'element ib 326 : * -prise en compte de l'epaisseur et de l'excentrement 327 : * dans le cas des coques minces avec ou sans cisaillement 328 : * transverse 329 : * 329 : CALL DEFVAL(NUMAT1,NBPTEL,NDEF, 330 : . IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET, 331 : . IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND, 332 : . WTRAV,WRK1,WRK5,SECT,EPAIST) 333 : * 334 : * on recupere les constantes du materiau 335 : * calcul des contraintes effectives en milieu poreux 336 : * 336 : CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS, 337 : . IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2, 338 : . WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB, 339 : . BID,BID2,KERR0) 340 : IF (KERR0.EQ.99) THEN 341 : KERRE=99 342 : GOTO 1000 343 : ELSE IF (KERR0.EQ.10) THEN 344 : GOTO 1000 345 : ENDIF 346 : * 347 : IF ((INPLAS.EQ.29.).OR.(INPLAS.EQ.26)) THEN 348 : * 349 : * pour les materiaux endommageables de lemaitre traitement special 350 : * car ils peuvent dependre de la temperature 351 : * 352 : NTABO1 = 0 353 : NTABO2 = 0 354 : SEGINI WR10 355 : DO 2200 JC=1,NMATT 356 : IF (TYMAT(JC)(1:8).EQ.'REAL*8 ') THEN 357 : NTABO1=NTABO1+1 358 : NTABO2=NTABO2+1 359 : SEGADJ WR10 360 : IABLO1(NTABO1)=1 361 : TABLO2(NTABO2)=XMAT(JC) 362 : ELSE IF (TYMAT(JC)(9:16).EQ.'EVOLUTIO') THEN 362 : CALL KSISIG(WRK0,JC,WRK2,NCOURB,KERRE) 363 : IF (KERRE.NE.0) GOTO 1990 364 : NTABO1=NTABO1+1 365 : NTABO=NTABO2 366 : NTABO2=NTABO2+(2*NCOURB) 367 : SEGADJ WR10 368 : IABLO1(NTABO1)=2*NCOURB 369 : DO 2050 JCC=1,NCOURB 370 : TABLO2(NTABO+(2*JCC-1))=TRAC(2*JCC-1) 371 : TABLO2(NTABO+(2*JCC))=TRAC(2*JCC) 372 : 2050 continue 373 : ELSE IF (TYMAT(JC)(9:16).EQ.'NUAGE ') THEN 374 : NTABO3 = 0 375 : NTABO4 = 0 376 : SEGINI WR11 376 : CALL XNUAGE(WRK0,JC,WR11,NTABO3,NTABO4,KERRE) 377 : IF (KERRE.NE.0) THEN 378 : SEGSUP WR10 379 : SEGSUP WR11 380 : KERR1=2 381 : GOTO 1990 382 : ENDIF 383 : * segadj wr11 384 : NTABO=NTABO1 385 : NTABOO=NTABO2 386 : NTABO1=NTABO1+NTABO3+1 387 : NTABO2=NTABO2+NTABO4 388 : SEGADJ WR10 389 : IABLO1(NTABO+1)=NTABO3 390 : DO 2075 JCC=1,NTABO3 391 : 2075 iablo1(ntabo+1+jcc)=iablo3(jcc) 392 : DO 2125 JCC=1,NTABO4 393 : 2125 tablo2(ntaboo+jcc)=tablo4(jcc) 394 : SEGSUP WR11 395 : ENDIF 396 : 2200 continue 397 : ENDIF 398 : * 399 : * >>>>>>>>>> fin du traitement du materiau 400 : * 401 : * on recupere les caracteristiques geometriques 402 : * 402 : CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR, 403 : . WRK1) 403 : * CALL DEFCAR(NCARR,ICARA,IB,IGAU,MFR,MELE,IVACAR, 404 : * . XCAR) 405 : * 406 : * 407 : * quelques impressions si iimpi = 99 408 : * 409 : * IF(IIMPI.EQ.99) THEN 410 : * WRITE(IOIMP,66770) IB,IGAU 411 : *66770 format(////////2x,'element ',i6,2x,'point ',i3//) 412 : * WRITE(IOIMP,66771) MATE,INPLAS 413 : *66771 format('0 mate=',i4,2x,'inplas=',i4/) 414 : * WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS) 415 : *66772 format(2x,' sig0 '/(6(1x,1pe12.5))) 416 : * WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI) 417 : *66773 format(2x,' var0 '/(6(1x,1pe12.5))) 418 : * WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS) 419 : *66774 format(2x,' depst '/(6(1x,1pe12.5))) 420 : * WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT) 421 : *66775 format(2x,' xmat '/(6(1x,1pe12.5))) 422 : * IF(IVACAR.NE.0)THEN 423 : * WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA) 424 : *66776 format(2x,' xcar '/(6(1x,1pe12.5))) 425 : * ENDIF 426 : * ENDIF 427 : * 428 : * mise à disposition des temperatures tini tfin tref 429 : * aux points de gauss 430 : * 431 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 432 : IBMN=MIN(IB,MELVA3.VELCHE(/2)) 433 : IGMN=MIN(IGAU,MELVA3.VELCHE(/1)) 434 : TETA1=MELVA3.VELCHE(IGMN,IBMN) 435 : IBMN=MIN(IB,MELVA4.VELCHE(/2)) 436 : IGMN=MIN(IGAU,MELVA4.VELCHE(/1)) 437 : TETA2=MELVA4.VELCHE(IGMN,IBMN) 438 : IBMN=MIN(IB,MELVA5.VELCHE(/2)) 439 : IGMN=MIN(IGAU,MELVA5.VELCHE(/1)) 440 : TETREF=MELVA5.VELCHE(IGMN,IBMN) 441 : ENDIF 442 : * 443 : * 444 : *--------------------------------------------------------------------- 445 : * 446 : * ecoulement selon les modeles 447 : * 448 : *--------------------------------------------------------------------- 449 : * 450 : * 451 : * modeles de viscoplasticite integres par consti 452 : * 453 : IF ( INPLAS .EQ. 29) THEN 454 : * 455 : NYOG=IABLO1(1) 456 : NYNU=IABLO1(2) 457 : NYALFA=IABLO1(3) 458 : NYSMAX=IABLO1(4) 459 : NYN=IABLO1(5) 460 : NYM=IABLO1(6) 461 : NYKK=IABLO1(7) 462 : NYALF1=IABLO1(8) 463 : NYBET1=IABLO1(9) 464 : NYR=IABLO1(10) 465 : NYA=IABLO1(11) 466 : IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33). 467 : + AND.IFOUR.EQ.-2) THEN 468 : INTMAT=15 469 : ELSE 470 : INTMAT=14 471 : ENDIF 472 : IF (NTABO1.EQ.INTMAT) THEN 473 : NNKX=1 474 : NYKX=IABLO1(12) 475 : ELSE 476 : NNKX=IABLO1(12) 477 : NYKX=0 478 : DO 1881 I=1,NNKX 479 : 1881 NYKX=NYKX+(2*IABLO1(12+I)) 480 : NYKX=NYKX+NNKX 481 : ENDIF 482 : NYRHO=IABLO1(NTABO1) 483 : NSIGY=1 484 : SEGINI WRK9 484 : CALL MAT29(WR10,WRK9,INPLAS,IFOUR,MFR) 485 : SEGSUP WR10 486 : IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN 487 : NCOURB=2*NKX(1) 488 : ELSE 489 : NCOURB=NKX(1) 490 : DO 1882 I=1,NNKX 491 : 1882 IF (NKX(I).GE.NCOURB) NCOURB=NKX(I) 492 : NCOURB=2*NCOURB 493 : ENDIF 494 : SEGINI WRK7 495 : IF (INPLAS.EQ.29.AND.VAR0(3).GE.0.96) THEN 495 : CALL ZDANUL(SIGF,NSTRS) 496 : DO 1883 I=1,NVARI 497 : VARF(I) = VAR0(I) 498 : 1883 CONTINUE 499 : VARF(3) = 1.0 500 : DO 1884 I=1,NSTRS 501 : EPINF(I) = EPIN0(I) 502 : 1884 CONTINUE 503 : SEGSUP WRK7 504 : SEGSUP WRK9 505 : ELSE 505 : CALL CONSTI(WRK0,WR00,WRK1,WRK5,WRK7,WRK8,WRK9,WTRAV, 506 : 1 INPLAS,MFR1,DT,NSTRSS,NVARI,NMATT,PRECIS,MSOUPA,JECHER,DTT, 507 : 2 NSSINC,INV,KERRE,ICARA,IFOURB,NYOG,NYNU,NYALFA,NYSMAX,NYN, 508 : 3 NYM,NYKK,NYALF1,NYBET1,NYR,NYA,NYKX,NNKX,NYRHO,NSIGY,TETA1, 509 : 5 TETA2,TREFA,TLIFE,ITHHER,NCOURB,CMATE,N2EL,N2PTEL,IB,IGAU, 510 : 6 EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI,KERREU1) 511 : c 512 : c 513 : SEGSUP WRK7 514 : SEGSUP WRK9 515 : IF (INPLAS.EQ.29.AND.TLIFE.GE.0.D0) THEN 516 : INTERR(1)=IB 517 : INTERR(2)=IGAU 518 : REAERR(1)=TLIFE 518 : CALL ERREUR(-279) 519 : ENDIF 520 : DTOPTI = MIN(DTOPTI,DTT) 521 : NINCMA = MAX(NINCMA,NSSINC) 522 : NCOMP = NCOMP + 1 523 : TSOM = TSOM + DTT 524 : NSOM = NSOM + NSSINC 525 : NINV = NINV + INV 526 : TCAR = TCAR + DTT* DTT 527 : IF(KERRE.NE.0) THEN 528 : KERR1=1 529 : END IF 530 : END IF 531 : c 532 : c modele plastique d'endommagement de lemaitre 533 : c ++++++++++++++++++++++++++++++++++++++++++++ 534 : c traitement du materiau qui depend eventuellement de la temperature 535 : c ------------------------------------------------------------------ 536 : ELSE IF (INPLAS.EQ.26) THEN 537 : NYOG=IABLO1(1) 538 : NYNU=IABLO1(2) 539 : NYRHO=IABLO1(3) 540 : NYALFA=IABLO1(4) 541 : IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33). 542 : + AND.IFOUR.EQ.-2) THEN 543 : INTMAT=10 544 : ELSE 545 : INTMAT=9 546 : ENDIF 547 : IF (NTABO1.EQ.INTMAT) THEN 548 : NNKX=1 549 : NYKX=IABLO1(5) 550 : IEPS=0 551 : ELSE 552 : NNKX=IABLO1(5) 553 : NYKX=0 554 : DO 1789 I=1,NNKX 555 : 1789 NYKX=NYKX+(2*IABLO1(5+I)) 556 : NYKX=NYKX+NNKX 557 : IEPS=1 558 : ENDIF 559 : IORIGI=6+(IEPS*NNKX) 560 : NYN=IABLO1(IORIGI) 561 : NYM=IABLO1(IORIGI+1) 562 : NYKK=IABLO1(IORIGI+2) 563 : NYSMAX=0 564 : NYALF1=0 565 : NYBET1=0 566 : NYR=0 567 : NYA=0 568 : NSIGY=0 569 : SEGINI WRK9 569 : CALL MAT29(WR10,WRK9,INPLAS,IFOUR,MFR) 570 : SEGSUP WR10 571 : c 572 : c *** si le pt. de gauss est ruine, les contr. sont annulees et 573 : c *** on n' ecoule pas 574 : c 574 : CALL DERTRA(NYM,YM,TETA2,DC,DCPRIM,DCINF,DCSUP) 575 : IF (VAR0(3).GE.1.D0.OR.VAR0(3).GE.DC) THEN 576 : DO 1115 IEN=1,NVARI 577 : VARF(IEN)=VAR0(IEN) 578 : 1115 continue 579 : VARF(3)=1.D0 579 : CALL ZDANUL(SIGF,NSTRS) 579 : CALL ZDANUL(DEFP,NSTRS) 580 : SEGSUP WRK9 581 : ELSE 582 : c ---------------------------------------------------------------------- 583 : c nnvari est le nbr. de var. int. pilotant les eq. du modele soit r et d 584 : c p est en supplement 585 : c ---------------------------------------------------------------------- 586 : NNVARI=2 587 : IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN 587 : CALL COTRAC(WRK0,WRK2,NCOURB,KERRE) 588 : NCOURB=2*NKX(1) 589 : ELSE 590 : NCOURB=NKX(1) 591 : DO 1119 I=1,NNKX 592 : 1119 if (nkx(i).ge.ncourb) ncourb=nkx(i) 593 : NCOURB=4*NCOURB 594 : ENDIF 595 : IF (KERRE.EQ.0) THEN 596 : SEGINI WRK7 596 : CALL ENDOM(WRK0,WR00,WRK1,WRK6,WRK7,WRK8,WRK9,WTRAV,NSTRSS, 597 : 1 NMATT,ICARA,INPLAS,NVARI,PRECIS,MFR1,IFOURB,KERRE,NNVARI, 598 : 2 NYOG,NYNU,NYRHO,NYALFA,NNKX,NYKX,NCOURB,NYN,NYM,NYKK,TETA1, 599 : 3 TETA2,TREFA,ITHHER,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST, 600 : 4 MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI) 601 : SEGSUP WRK7 602 : SEGSUP WRK9 603 : IF(KERRE.GT.200) THEN 604 : KERR1=1 605 : END IF 606 : END IF 607 : END IF 608 : ELSE 609 : KERRE = 99 610 : ENDIF 611 : * 612 : * Erreurs 613 : * - problèmes de convergence 614 : * 614 : CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC) 615 : * 616 : * - autres problèmes 617 : * 617 : 1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU, 618 : . KERR1,KERRE) 619 : 1998 IF (KERRE.GT.0) THEN 620 : IF (LOGVIS) SEGSUP WRK8 621 : SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV 622 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN 623 : SEGSUP WRK4 624 : ENDIF 625 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 626 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 627 : 1 .OR.MFR.EQ.33)) THEN 628 : SEGDES MINTE2 629 : SEGSUP WRK22 630 : ENDIF 631 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 632 : SEGDES MELVA3 633 : SEGDES MELVA4 634 : SEGDES MELVA5 635 : SEGDES MCHAM3 636 : SEGDES MCHAM4 637 : SEGDES MCHAM5 638 : ENDIF 639 : RETURN 640 : ENDIF 641 : c 642 : c 643 : c remplissage du segment contenant les contraintes a la fin 644 : * ( rearrangement pour milieu poreux ), 645 : c les variables internes finales 646 : c et les increments de deformations plastiques 647 : c 647 : CALL DEFSIG(MFR,NDEF, 648 : . INPLAS,IND,WRK1,WRK5,WTRAV, 649 : . IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU, 650 : . CMATE,MATE,MELE,KERRER) 651 : IF (KERRER.GT.0) GOTO 1000 652 : c 653 : c 654 : c fin de la boucle sur les points de gauss 655 : c 656 : 1100 continue 657 : c 658 : c special poutres et tuyaux sauf timoschenko 659 : c 659 : CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF) 660 : c 661 : c fin de la boucle sur les elements 662 : c 663 : 1000 continue 664 : c 665 : * FIN: modèles visqueux, on stocke le pas de temps 666 : * optimal en indice 'dtopti' 667 : * 667 : CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA, 668 : . TCAR,DTOPTI,IPOTAB,KERRE) 669 : IF (LOGVIS) SEGSUP WRK8 670 : * 671 : * 672 : SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV 673 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN 674 : SEGSUP WRK4 675 : END IF 676 : IF(INPLAS.EQ.26) THEN 677 : SEGSUP WRK6 678 : SEGSUP WRK8 679 : END IF 680 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 681 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 682 : 1 .OR.MFR.EQ.33)) THEN 683 : SEGDES MINTE2 684 : SEGSUP WRK22 685 : ENDIF 686 : * 687 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 688 : SEGDES MELVA3 689 : SEGDES MELVA4 690 : SEGDES MELVA5 691 : SEGDES MCHAM3 692 : SEGDES MCHAM4 693 : SEGDES MCHAM5 694 : ENDIF 695 : * 696 : RETURN 697 : END 698 : 699 : 700 : 701 : 702 : 703 : 704 : 705 : 706 : 707 : 708 : 709 : 710 : 711 : 712 : 713 : 714 : 715 : 716 : 717 : 718 : 719 : 720 : 721 : 722 :
© Cast3M 2003 - All rights reserved.
Disclaimer