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