1 : C ECOU50 SOURCE CHAT 11/03/16 21:20:08 6902 2 : SUBROUTINE ECOU50(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: -PLASTIQUE_ENDOM(MAGEABLE) 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 ENDO0 143 : REAL*8 ENDO(LENDO),RAPP(LENDO) 144 : ENDSEGMENT 145 : * 146 : SEGMENT WRK22 147 : REAL*8 XXE(3,NBNN) 148 : ENDSEGMENT 149 : * 150 : SEGMENT WRK3 151 : REAL*8 WORK(LW),WORK2(LW2) 152 : ENDSEGMENT 153 : * 154 : SEGMENT WRK4 155 : REAL*8 XE(3,NBBB) 156 : ENDSEGMENT 157 : * 158 : SEGMENT WRK5 159 : REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS) 160 : ENDSEGMENT 161 : * 162 : SEGMENT WRK6 163 : REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS) 164 : REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS) 165 : REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS) 166 : ENDSEGMENT 167 : * 168 : SEGMENT WRK7 169 : REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB) 170 : ENDSEGMENT 171 : * 172 : SEGMENT WRK8 173 : REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS) 174 : ENDSEGMENT 175 : * 176 : SEGMENT WRK9 177 : REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX) 178 : REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1) 179 : REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO) 180 : REAL*8 SIGY(NSIGY) 181 : INTEGER NKX(NNKX) 182 : ENDSEGMENT 183 : * 184 : SEGMENT WR10 185 : INTEGER IABLO1(NTABO1) 186 : REAL*8 TABLO2(NTABO2) 187 : ENDSEGMENT 188 : * 189 : SEGMENT WR11 190 : INTEGER IABLO3(NTABO3) 191 : REAL*8 TABLO4(NTABO4) 192 : ENDSEGMENT 193 : * 194 : SEGMENT WTRAV 195 : REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT) 196 : REAL*8 VALCAR(NUCAR),DSIGT(NSTRS) 197 : REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK) 198 : REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM) 199 : REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK) 200 : ENDSEGMENT 201 : * 202 : SEGMENT WPOUT 203 : REAL*8 X(2),Y(2),Z(2) 204 : ENDSEGMENT 205 : * 206 : SEGMENT DRA0 207 : REAL*8 AAA(LDRA0) 208 : ENDSEGMENT 209 : * 210 : * Commun NECOU utilisé dans ECOINC 211 : * 212 : COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 213 : . ITYP,IFOURB,IFLUAG, 214 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 215 : . JFLUAG,KFLUAG,LFLUAG, 216 : . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 217 : * 218 : * Commun IECOU: sert de fourre-tout pour les initialisations 219 : * d'entiers 220 : * 221 : COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK, 222 : . NYALF1,NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND, 223 : . NSOM,NINV,NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT, 224 : . LTRAC,MFR,IELE,NHRM,NBNN,NBELEM,ICARA, 225 : . LW2,NDEF,NSTRSS,MFR1,NBGMAT,NELMAT,MSOUPA, 226 : . NUMAT1,LENDO,NBBB,NNVARI,KERR1,MELEME, 227 : . icou45,icou46,icou47,icou48,icou49,icou50, 228 : . icou51,icou52,icou53,icou54,icou55,icou56 229 : . icou57,icou58 230 : * 231 : * Commun XECOU: sert de fourre-tout pour les initialisations 232 : * de réels 233 : * 234 : COMMON/XECOU/DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP0 235 : * 236 : LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC 237 : LOGICAL LUNI1,LUNI2 238 : DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12) 239 : * 240 : CHARACTER*72 CHARRE 241 : CHARACTER*8 CMATE 242 : c 243 : * 244 : * mise à disposition des temperatures tini tfin tref 245 : * aux points de gauss 246 : * 247 : TETA1=-1.E35 248 : TETA2=-1.E35 249 : TETREF=-1.E35 250 : TREFA=-1.E35 251 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 252 : MCHAM3=IPH1 253 : MCHAM4=IPH2 254 : MCHAM5=IPH3 255 : SEGACT MCHAM3 256 : SEGACT MCHAM4 257 : SEGACT MCHAM5 258 : MELVA3=MCHAM3.IELVAL(1) 259 : MELVA4=MCHAM4.IELVAL(1) 260 : MELVA5=MCHAM5.IELVAL(1) 261 : SEGACT MELVA3 262 : SEGACT MELVA4 263 : SEGACT MELVA5 264 : ENDIF 265 : c 266 : c 267 : c Initialisations de variables 268 : c--------------------------------- 269 : c - mise à zéro des variables du commun NECOU si besoin 270 : c - modèles viscoplastiques: 271 : c . on récupère le pas de temps 272 : c . on récupère le nombre maximal de sous-pas 273 : c . on met IND=1 274 : c - initialisation des dimensions des tableaux des segments 275 : c Sorties: en plus du commun NECOU, on range les autres données 276 : c initialisées dans les COMMON IECOU et XECOU 277 : c Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme 278 : c argument de DEFINI 279 : c 279 : CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE, 280 : . ISTEP,INPLAS,NPINT,IPOTAB,IVADEF, 281 : . IPMAIL,IVAMAT, 282 : . ITHHER,NUMAT,NUCAR,LOGVIS, 283 : . LUNI1,LUNI2,LW,KERRE) 284 : IF (KERRE.EQ.999) RETURN 285 : c 286 : c Initialisations des segments de travail 287 : c 288 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 289 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 290 : 1 .OR.MFR.EQ.33)) THEN 290 : CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1) 291 : MINTE2=IPTR1 292 : SEGACT MINTE2 293 : SEGINI WRK22 294 : ENDIF 295 : c 296 : IF (LOGVIS) SEGINI WRK8 297 : * 298 : SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5 299 : IF (INPLAS.EQ.51) SEGINI ENDO0 300 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN 301 : SEGINI WRK4 302 : ENDIF 303 : c 304 : SEGINI WTRAV 305 : IF (INPLAS.EQ.75) THEN 306 : LDRA0=951 307 : SEGINI DRA0 308 : ENDIF 309 : * 310 : * 311 : * boucle sur les elements 312 : * 313 : DO 1000 IB=1,NBELEM 314 : * 315 : * Matériaux orthotropes, anisotropes et unidirectionnels 316 : * en formulation massive: 317 : * - on cherche les coordonnees des noeuds de l element ib 318 : * - calcul des axes locaux 319 : * Cas particulier de l'ACIER_UNI 320 : * 320 : CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1, 321 : . MELEME,WRK4,WRK22,WTRAV) 322 : * 323 : * 324 : * boucle sur les points de gauss 325 : * 326 : DO 1100 IGAU=1,NBPTEL 327 : * 328 : * -recuperation de valmat et de valcar 329 : * -on recupere les contraintes initiales 330 : * -on recupere les variables internes 331 : * -on recupere les deformations inelastiques initiales si besoin 332 : * -on recupere les increments de deformations totales 333 : * -on cherche la section de l'element ib 334 : * -prise en compte de l'epaisseur et de l'excentrement 335 : * dans le cas des coques minces avec ou sans cisaillement 336 : * transverse 337 : * 337 : CALL DEFVAL(NUMAT1,NBPTEL,NDEF, 338 : . IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET, 339 : . IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND, 340 : . WTRAV,WRK1,WRK5,SECT,EPAIST) 341 : * 342 : * on recupere les constantes du materiau 343 : * calcul des contraintes effectives en milieu poreux 344 : * 344 : CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS, 345 : . IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2, 346 : . WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB, 347 : . BID,BID2,KERR0) 348 : IF (KERR0.EQ.99) THEN 349 : KERRE=99 350 : GOTO 1000 351 : ELSE IF (KERR0.EQ.10) THEN 352 : GOTO 1000 353 : ENDIF 354 : * 355 : * >>>>>>>>>> fin du traitement du materiau 356 : * 357 : * on recupere les caracteristiques geometriques 358 : * 358 : CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR, 359 : . WRK1) 360 : * 361 : * 362 : * quelques impressions si iimpi = 99 363 : * 364 : * IF(IIMPI.EQ.99) THEN 365 : * WRITE(IOIMP,66770) IB,IGAU 366 : *66770 format(////////2x,'element ',i6,2x,'point ',i3//) 367 : * WRITE(IOIMP,66771) MATE,INPLAS 368 : *66771 format('0 mate=',i4,2x,'inplas=',i4/) 369 : * WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS) 370 : *66772 format(2x,' sig0 '/(6(1x,1pe12.5))) 371 : * WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI) 372 : *66773 format(2x,' var0 '/(6(1x,1pe12.5))) 373 : * WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS) 374 : *66774 format(2x,' depst '/(6(1x,1pe12.5))) 375 : * WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT) 376 : *66775 format(2x,' xmat '/(6(1x,1pe12.5))) 377 : * IF(IVACAR.NE.0)THEN 378 : * WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA) 379 : *66776 format(2x,' xcar '/(6(1x,1pe12.5))) 380 : * ENDIF 381 : * ENDIF 382 : * 383 : * mise à disposition des temperatures tini tfin tref 384 : * aux points de gauss 385 : * 386 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 387 : IBMN=MIN(IB,MELVA3.VELCHE(/2)) 388 : IGMN=MIN(IGAU,MELVA3.VELCHE(/1)) 389 : TETA1=MELVA3.VELCHE(IGMN,IBMN) 390 : IBMN=MIN(IB,MELVA4.VELCHE(/2)) 391 : IGMN=MIN(IGAU,MELVA4.VELCHE(/1)) 392 : TETA2=MELVA4.VELCHE(IGMN,IBMN) 393 : IBMN=MIN(IB,MELVA5.VELCHE(/2)) 394 : IGMN=MIN(IGAU,MELVA5.VELCHE(/1)) 395 : TETREF=MELVA5.VELCHE(IGMN,IBMN) 396 : ENDIF 397 : * 398 : * 399 : *--------------------------------------------------------------------- 400 : * 401 : * ecoulement selon les modeles 402 : * 403 : *--------------------------------------------------------------------- 404 : * 405 : c 406 : c 407 : c modeles implantes dans ecoinc 408 : c 409 : IF (INPLAS.EQ.51) THEN 410 : c 411 : c cas de la plasticite isotrope ecrouissable avec un 412 : c endommagement de type P/Y 413 : c 414 : c on recupere la courbe de traction et la courbe de début d'endommagement 415 : c 415 : CALL COEND(WRK0,WRK2,ENDO0,NCOURB,NENDO, 416 : 1 NRAPP,KERRE) 417 : INPLS0 = 5 418 : IF (VAR0(7).GE.1.D-10) THEN 419 : DO 110 I=1,NSTRS 420 : SIG0(I)=SIG0(I)/VAR0(7) 421 : 110 CONTINUE 422 : ENDIF 423 : c 424 : c calcul des contraintes plastiquement admissibles 425 : c 426 : IF (KERRE .EQ. 0) THEN 427 : DO 1114 IC=1,ICARA 428 : WORK(IC)=XCAR(IC) 429 : 1114 continue 430 : BID(1)=0.D00 431 : BID(2)=0.D00 432 : BID(3)=0.D00 432 : CALL ECOINC(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL, 433 : 1 N2PTEL,VAR0,BID,BID,XMAT,PRECIS,WORK2,WORK,TRAC, 434 : 2 SIGF,VARF,DEFP,KERRE,MFR1,IB,IGAU,NSTRSS,EPAIST,MELE, 435 : 3 NPINT,NBPGAU,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC, 436 : 4 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,INPLS0) 437 : END IF 438 : c 439 : c retour au modèle d'endommagement P/Y 440 : c 441 : c calcul des contraintes endommagées 442 : c 442 : CALL PSURY(ENDO,NENDO,NVARI,NSTRSS,MFR1,DEPST,XMAT,VAR0, 443 : 1 RAPP,NRAPP, 444 : 1 SIG0,SIGF,VARF,NMATT,DEFP,KERRE) 445 : c 446 : c 447 : ELSE IF (INPLAS.EQ.62) THEN 448 : c 449 : c Modèle d'endommagement de Rousselier 450 : c - on recupère la courbe de traction 451 : c 451 : CALL COTRAC(WRK0,WRK2,NCOURB,KERRE) 452 : c 453 : c - appel au modèle 454 : C 455 : IF(KERRE.EQ.0) THEN 456 : inecou=0 456 : CALL ROUSS(DEPST,NSTRSS,MFR1,IB,IGAU, 457 : 1 DSIGT,NCOMAT,SIG0,VAR0,XMAT,XCAR,NVARI,ICARA, 458 : 2 SIGF,VARF,DEFP,TRAC,KERRE,inecou) 459 : IF((KERRE.GT.0).AND.(KERRE.NE.99)) THEN 460 : KERR1=1 461 : ENDIF 462 : ENDIF 463 : c 464 : c 465 : ELSE IF (INPLAS.EQ.64) THEN 466 : c 467 : c Modèle d'endommagement de Gurson modifié Needleman Tvergaard 468 : c - on recupère la courbe de traction 469 : c 469 : CALL COTRAC(WRK0,WRK2,NCOURB,KERRE) 470 : c 471 : c - appel au modèle 472 : c 473 : IF(KERRE.EQ.0) THEN 474 : inecou=0 474 : CALL GURSO2(DEPST,NSTRSS,MFR1,IB,IGAU, 475 : 1 DSIGT,NCOMAT,SIG0,VAR0,XMAT,XCAR,NVARI,ICARA, 476 : 2 SIGF,VARF,DEFP,TRAC,KERRE,inecou) 477 : IF((KERRE.GT.0).AND.(KERRE.NE.99)) THEN 478 : KERR1=1 479 : END IF 480 : ENDIF 481 : c 482 : c 483 : ELSE IF (INPLAS.EQ.75) THEN 484 : c 485 : c Modèle d'endommagement de Dragon 486 : c 486 : CALL DRAGON(WRK0,WRK1,WRK5,DRA0,KERRE) 487 : c 488 : c 489 : ELSE 490 : KERRE = 99 491 : ENDIF 492 : * 493 : * Erreurs 494 : * - problèmes de convergence 495 : * 495 : CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC) 496 : * 497 : * - autres problèmes 498 : * 498 : 1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU, 499 : . KERR1,KERRE) 500 : 1998 IF (KERRE.NE.0) THEN 501 : IF (LOGVIS) SEGSUP WRK8 502 : SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV 503 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN 504 : SEGSUP WRK4 505 : ENDIF 506 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 507 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 508 : 1 .OR.MFR.EQ.33)) THEN 509 : SEGDES MINTE2 510 : SEGSUP WRK22 511 : ENDIF 512 : IF (INPLAS.EQ.51) SEGSUP ENDO0 513 : IF (INPLAS.EQ.75) SEGSUP DRA0 514 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 515 : SEGDES MELVA3 516 : SEGDES MELVA4 517 : SEGDES MELVA5 518 : SEGDES MCHAM3 519 : SEGDES MCHAM4 520 : SEGDES MCHAM5 521 : ENDIF 522 : RETURN 523 : ENDIF 524 : * 525 : c 526 : c remplissage du segment contenant les contraintes a la fin 527 : * ( rearrangement pour milieu poreux ), 528 : c les variables internes finales 529 : c et les increments de deformations plastiques 530 : c 530 : CALL DEFSIG(MFR,NDEF, 531 : . INPLAS,IND,WRK1,WRK5,WTRAV, 532 : . IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU, 533 : . CMATE,MATE,MELE,KERRER) 534 : IF (KERRER.NE.0) GOTO 1000 535 : c 536 : c 537 : c fin de la boucle sur les points de gauss 538 : c 539 : 1100 continue 540 : c 541 : c special poutres et tuyaux sauf timoschenko 542 : c 542 : CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF) 543 : c 544 : c fin de la boucle sur les elements 545 : c 546 : 1000 continue 547 : c 548 : * FIN: modèles visqueux, on stocke le pas de temps 549 : * optimal en indice 'dtopti' 550 : * 550 : CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA, 551 : . TCAR,DTOPTI,IPOTAB,KERRE) 552 : IF (LOGVIS) SEGSUP WRK8 553 : * 554 : * 555 : SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV 556 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN 557 : SEGSUP WRK4 558 : END IF 559 : IF (INPLAS.EQ.51) SEGSUP ENDO0 560 : IF (INPLAS.EQ.75) SEGSUP DRA0 561 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 562 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 563 : 1 .OR.MFR.EQ.33)) THEN 564 : SEGDES MINTE2 565 : SEGSUP WRK22 566 : ENDIF 567 : * 568 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 569 : SEGDES MELVA3 570 : SEGDES MELVA4 571 : SEGDES MELVA5 572 : SEGDES MCHAM3 573 : SEGDES MCHAM4 574 : SEGDES MCHAM5 575 : ENDIF 576 : * 577 : RETURN 578 : END 579 : 580 : 581 : 582 : 583 : 584 : 585 : 586 : 587 : 588 : 589 : 590 : 591 : 592 : 593 : 594 : 595 : 596 : 597 : 598 : 599 : 600 : 601 : 602 : 603 : 604 : 605 : 606 : 607 : 608 : 609 : 610 : 611 : 612 : 613 : 614 :
© Cast3M 2003 - All rights reserved.
Disclaimer