1 : C ECOU40 SOURCE CHAT 11/03/16 21:20:06 6902 2 : SUBROUTINE ECOU40(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 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),XMULT(NSTRS),PROD(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 : c 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 259 : c Initialisations de variables 260 : c--------------------------------- 261 : c - mise à zéro des variables du commun NECOU si besoin 262 : c - modèles viscoplastiques: 263 : c . on récupère le pas de temps 264 : c . on récupère le nombre maximal de sous-pas 265 : c . on met IND=1 266 : c - initialisation des dimensions des tableaux des segments 267 : c Sorties: en plus du commun NECOU, on range les autres données 268 : c initialisées dans les COMMON IECOU et XECOU 269 : c Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme 270 : c argument de DEFINI 271 : c 271 : CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE, 272 : . ISTEP,INPLAS,NPINT,IPOTAB,IVADEF, 273 : . IPMAIL,IVAMAT, 274 : . ITHHER,NUMAT,NUCAR,LOGVIS, 275 : . LUNI1,LUNI2,LW,KERRE) 276 : IF (KERRE.EQ.999) RETURN 277 : c 278 : c Initialisations des segments de travail 279 : c 280 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 281 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 282 : 1 .OR.MFR.EQ.33)) THEN 282 : CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1) 283 : MINTE2=IPTR1 284 : SEGACT MINTE2 285 : SEGINI WRK22 286 : ENDIF 287 : c 288 : IF (LOGVIS) SEGINI WRK8 289 : SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5 290 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN 291 : SEGINI WRK4 292 : ENDIF 293 : * IF(INPLAS.EQ.34)THEN 294 : * SEGINI WRK8 295 : * ENDIF 296 : c 297 : SEGINI WTRAV 298 : * 299 : * 300 : * boucle sur les elements 301 : * 302 : DO 1000 IB=1,NBELEM 303 : * 304 : * Matériaux orthotropes, anisotropes et unidirectionnels 305 : * en formulation massive: 306 : * - on cherche les coordonnees des noeuds de l element ib 307 : * - calcul des axes locaux 308 : * Cas particulier de l'ACIER_UNI 309 : * 309 : CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1, 310 : . MELEME,WRK4,WRK22,WTRAV) 311 : * 312 : * 313 : * boucle sur les points de gauss 314 : * 315 : DO 1100 IGAU=1,NBPTEL 316 : * 317 : * -recuperation de valmat et de valcar 318 : * -on recupere les contraintes initiales 319 : * -on recupere les variables internes 320 : * -on recupere les deformations inelastiques initiales si besoin 321 : * -on recupere les increments de deformations totales 322 : * -on cherche la section de l'element ib 323 : * -prise en compte de l'epaisseur et de l'excentrement 324 : * dans le cas des coques minces avec ou sans cisaillement 325 : * transverse 326 : * 326 : CALL DEFVAL(NUMAT1,NBPTEL,NDEF, 327 : . IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET, 328 : . IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND, 329 : . WTRAV,WRK1,WRK5,SECT,EPAIST) 330 : * 331 : * on recupere les constantes du materiau 332 : * calcul des contraintes effectives en milieu poreux 333 : * 333 : CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS, 334 : . IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2, 335 : . WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB, 336 : . BID,BID2,KERR0) 337 : IF (KERR0.EQ.99) THEN 338 : KERRE=99 339 : GOTO 1000 340 : ELSE IF (KERR0.EQ.10) THEN 341 : GOTO 1000 342 : ENDIF 343 : * 344 : * >>>>>>>>>> fin du traitement du materiau 345 : * 346 : * on recupere les caracteristiques geometriques 347 : * 347 : CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR, 348 : . WRK1) 349 : * 350 : * 351 : * quelques impressions si iimpi = 99 352 : * 353 : * IF(IIMPI.EQ.99) THEN 354 : * WRITE(IOIMP,66770) IB,IGAU 355 : *66770 format(////////2x,'element ',i6,2x,'point ',i3//) 356 : * WRITE(IOIMP,66771) MATE,INPLAS 357 : *66771 format('0 mate=',i4,2x,'inplas=',i4/) 358 : * WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS) 359 : *66772 format(2x,' sig0 '/(6(1x,1pe12.5))) 360 : * WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI) 361 : *66773 format(2x,' var0 '/(6(1x,1pe12.5))) 362 : * WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS) 363 : *66774 format(2x,' depst '/(6(1x,1pe12.5))) 364 : * WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT) 365 : *66775 format(2x,' xmat '/(6(1x,1pe12.5))) 366 : * IF(IVACAR.NE.0)THEN 367 : * WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA) 368 : *66776 format(2x,' xcar '/(6(1x,1pe12.5))) 369 : * ENDIF 370 : * ENDIF 371 : * 372 : * mise à disposition des temperatures tini tfin tref 373 : * aux points de gauss 374 : * 375 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 376 : IBMN=MIN(IB,MELVA3.VELCHE(/2)) 377 : IGMN=MIN(IGAU,MELVA3.VELCHE(/1)) 378 : TETA1=MELVA3.VELCHE(IGMN,IBMN) 379 : IBMN=MIN(IB,MELVA4.VELCHE(/2)) 380 : IGMN=MIN(IGAU,MELVA4.VELCHE(/1)) 381 : TETA2=MELVA4.VELCHE(IGMN,IBMN) 382 : IBMN=MIN(IB,MELVA5.VELCHE(/2)) 383 : IGMN=MIN(IGAU,MELVA5.VELCHE(/1)) 384 : TETREF=MELVA5.VELCHE(IGMN,IBMN) 385 : ENDIF 386 : * 387 : * 388 : *--------------------------------------------------------------------- 389 : * 390 : * ecoulement selon les modeles 391 : * 392 : *--------------------------------------------------------------------- 393 : * 394 : IF (INPLAS .EQ. 30) THEN 395 : c 396 : c modele d'endommagement mazars ( beton ) 397 : c 397 : CALL MAZZZ (WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP, 398 : & ICARA,KERRE,MFR1) 399 : c 400 : ELSE IF (INPLAS .EQ. 31) THEN 401 : c 402 : c modele d'endommagement unilateral ( beton ) 403 : c 403 : CALL CLBBBB (WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP, 404 : & ICARA,KERRE,MFR1,IFOURB) 405 : c 406 : ELSE IF (INPLAS .EQ. 37) THEN 407 : c 408 : c modele rotating crack 409 : c 409 : CALL ROTATI (WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP, 410 : & ICARA,KERRE) 411 : c 412 : ELSE IF (INPLAS .EQ. 88) THEN 413 : c modele SIC_SIC 414 : c 414 : CALL SICSIC(WRK0,WRK1,WRK22,WRK5,WTRAV,CMATE,N2EL, 415 : & N2PTEL,IB,IGAU,EPAIST,NVARI,NBPGAU,MELE,NPINT, 416 : & SECT,LHOOK,CRIGI,NMATT,ISTEP,KERRE) 417 : c 418 : ELSE IF (INPLAS .EQ. 89) THEN 419 : C HINTE 420 : C MODELE INTERFACE 2D 421 : 421 : CALL HINTE(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT, 422 : . XCAR,SIGF,VARF,DEFP,PRECIS,MFR1,KERRE) 423 : C 424 : 425 : ELSE IF (INPLAS .EQ. 96) THEN 426 : C 427 : C MODELE D'ENDOMMAGEMENT + PLASTICITE ANISOTROPE MICROPLANS 428 : C 428 : CALL MICROP (WRK0,WRK1,NSTRSS,NVARI,NMATT, 429 : & ICARA,KERRE,MFR1,IFOURB) 430 : * 431 : ELSE IF (INPLAS .EQ. 97) THEN 432 : C 433 : C MODELE D'ENDOMMAGEMENT VISCOUNILATERAL ( BETON ) 434 : C 434 : CALL JFDDDD (WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP, 435 : & ICARA,KERRE,MFR1,IFOURB,DT) 436 : * 437 : ELSE IF (INPLAS .EQ. 98) THEN 438 : C 439 : C MODELE D'ENDOMMAGEMENT + PLASTICITE ISOTROPE MICROPLANS 440 : C 440 : CALL MICROI (WRK0,WRK1,NSTRSS,NVARI,NMATT, 441 : & ICARA,KERRE,MFR1,IFOURB) 442 : * 443 : * BCN 444 : ELSE IF (INPLAS .EQ. 118) THEN 445 : C Modified Von Mises model 445 : CALL MVMMM (WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP, 446 : & ICARA,KERRE,MFR1) 447 : ELSE IF (INPLAS .EQ. 134) THEN 448 : C Modele de desmorat 448 : CALL DESMNL(WRK0,WRK1,WRK5,NSTRSS,NVARI,LHOOK,ISTEP, 449 : & NMATT,ICARA,KERRE,MFR1) 450 : ELSE IF (INPLAS .EQ. 135) THEN 451 : * Modele plastique endommageable ENDO_PLAS 451 : CALL ENPLAS(XMAT,NMATT,VAR0,VARF,NVARI,SIG0, 452 : & SIGF,DEPST,NSTRS,KERRE,ISTEP) 453 : C Fatigue damage model 454 : ELSE IF (INPLAS .EQ. 141) THEN 454 : CALL FATTT (WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP, 455 : & ICARA,KERRE,MFR1,DT) 456 : 457 : 458 : ELSE 459 : KERRE = 99 460 : ENDIF 461 : * 462 : * Erreurs 463 : * - problèmes de convergence 464 : * 464 : CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC) 465 : * 466 : * - autres problèmes 467 : * 467 : 1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU, 468 : . KERR1,KERRE) 469 : 1998 IF (KERRE.NE.0) THEN 470 : IF (LOGVIS) SEGSUP WRK8 471 : SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV 472 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN 473 : SEGSUP WRK4 474 : ENDIF 475 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 476 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 477 : 1 .OR.MFR.EQ.33)) THEN 478 : SEGDES MINTE2 479 : SEGSUP WRK22 480 : ENDIF 481 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 482 : SEGDES MELVA3 483 : SEGDES MELVA4 484 : SEGDES MELVA5 485 : SEGDES MCHAM3 486 : SEGDES MCHAM4 487 : SEGDES MCHAM5 488 : ENDIF 489 : RETURN 490 : ENDIF 491 : c 492 : c 493 : c remplissage du segment contenant les contraintes a la fin 494 : * ( rearrangement pour milieu poreux ), 495 : c les variables internes finales 496 : c et les increments de deformations plastiques 497 : c 497 : CALL DEFSIG(MFR,NDEF, 498 : . INPLAS,IND,WRK1,WRK5,WTRAV, 499 : . IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU, 500 : . CMATE,MATE,MELE,KERRER) 501 : IF (KERRER.NE.0) GOTO 1000 502 : c 503 : c 504 : c fin de la boucle sur les points de gauss 505 : c 506 : 1100 continue 507 : c 508 : c special poutres et tuyaux sauf timoschenko 509 : c 509 : CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF) 510 : c 511 : c fin de la boucle sur les elements 512 : c 513 : 1000 continue 514 : * 515 : * FIN: modèles visqueux, on stocke le pas de temps 516 : * optimal en indice 'dtopti' 517 : * 517 : CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA, 518 : . TCAR,DTOPTI,IPOTAB,KERRE) 519 : IF (LOGVIS) SEGSUP WRK8 520 : * 521 : SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV 522 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN 523 : SEGSUP WRK4 524 : END IF 525 : * IF(INPLAS.EQ.34) THEN 526 : * SEGSUP WRK8 527 : * END IF 528 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 529 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 530 : 1 .OR.MFR.EQ.33)) THEN 531 : SEGDES MINTE2 532 : SEGSUP WRK22 533 : ENDIF 534 : * 535 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 536 : SEGDES MELVA3 537 : SEGDES MELVA4 538 : SEGDES MELVA5 539 : SEGDES MCHAM3 540 : SEGDES MCHAM4 541 : SEGDES MCHAM5 542 : ENDIF 543 : * 544 : RETURN 545 : END 546 : 547 : 548 : 549 : 550 : 551 : 552 : 553 : 554 : 555 : 556 : 557 : 558 : 559 : 560 : 561 : 562 : 563 : 564 : 565 : 566 : 567 : 568 : 569 : 570 : 571 : 572 : 573 : 574 : 575 : 576 : 577 :
© Cast3M 2003 - All rights reserved.
Disclaimer