1 : C ECOU21 SOURCE CHAT 11/03/16 21:19:58 6902 2 : SUBROUTINE ECOU21(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 : * CAS DES CERAMIQUES 10 : *********************************************************************** 11 : * entrees : 12 : * 13 : * mate = numero de materiau elastique 14 : * inplas = numero de materiau inelastique 15 : * mele = numero element fini 16 : * ipmail = pointeur du maillage 17 : * nbptel = nombre de points par element 18 : * imat = pointeur sur un segment mptval de materiau (utilise par calsig) 19 : * icar = pointeur sur un segment mptval de caracteristiques 20 : * geometriques (utilise par calsig) 21 : * numat = nb de composantes du melval de imat 22 : * nucar = nb de composantes du melval de icar 23 : * ivastr =pointeur sur un segment mptval de contraintes 24 : * ivari =pointeur sur un segment mptval de variables internes 25 : * ivadef =pointeur sur un segment mptval de deformations 26 : * ivads =pointeur sur un segment mptval de contraintes (increments) 27 : * ivamat =pointeur sur un segment mptval de materiau 28 : * ivacar =pointeur sur un segment mptval de cacarteristiques geometrique 29 : * iph1 = pointeur sur un mchaml de temperatures au debut du pas 30 : * iph2 = pointeur sur un mchaml de temperatures a la fin du pas 31 : * iph3 = pointeur sur un mchaml de temperatures de reference 32 : * ithher = 0 si pas de chargement thermique 33 : * = 1 si chargement thermique mais materiau constant 34 : * = 2 si chargement thermique et mat. dependant de la temperature 35 : * ipch1,ipch2,ipch3,ithher ne servent que pour les materiaux 36 : * endommageables de lemaitre quand ils dependent de la temperature 37 : * lhook =taille de la matrice de hooke 38 : * nstrs =nombre de composantes de contraintes 39 : * nvari =nombre de composantes de variables internes 40 : * nmatt =nombre de composnates de proprietes de materiau 41 : * ncarr =nombre de composnates de caracteristiques geometriques 42 : * cmate =nom du materiau 43 : * precis =precision dans les iterations internes 44 : * jecher =0 ou 1 pour action dans ecoule 45 : * jnoid =0 ou 1 pour action dans ecoule 46 : * ipotab =pointeur sur segment table 47 : * istep =indicateur d'action pour calcul nonlocal 48 : * =0 dans le cas d'un calcul local (normal) 49 : * =1 ou 2 dans le cas d'un calcul nonlocal 50 : * =1 pour calcul des fonctions seuil uniquement 51 : * =2 pour calcul des variables dissipatives a partir 52 : * des fonctions seuil moyennees prealablement par nloc 53 : * 54 : * sorties : 55 : * ivastf =pointeur sur un segment mptval de contraintes 56 : * ivarif =pointeur sur un segment mptval de variables internes 57 : * ivadep =pointeur sur un segment mptval de deformations inelastiques 58 : * kerre =indicateur d'erreur 59 : * 60 : * p dowlatyari fev. 1992 61 : * 62 : * c. la borderie fev 92 restructuration et reecriture de certains 63 : * passages pour une meilleure lisibilite 64 : * 65 : * avril 92 ajout istep pour le non local 66 : * dec 92 modif pour poutres timoschenko 67 : * 68 : ************************************************************************ 69 : IMPLICIT INTEGER(I-N) 70 : IMPLICIT REAL*8(A-H,O-Z) 71 : * 72 : -INC CCOPTIO 73 : -INC SMCHAML 74 : -INC SMELEME 75 : -INC SMCOORD 76 : -INC SMMODEL 77 : -INC SMINTE 78 : -INC CCHAMP 79 : c======================================================================= 80 : c la variable kerre regit les impressions d erreurs dans plast 81 : c toutes erreurs de ecoule gerees dans ce sous programme 82 : c kerre=0 tout ok 83 : c de 1 a 6 s aligner sur valeurs donnees par ecoinc 84 : c = 7 un element tuyau a une epaisseur nulle 85 : c = 21 on ne trouve pas d intersection avec la surface de charge 86 : c = 22 sig0 a l exterieur de la surface de charge 87 : c 88 : c anomalies avec la courbe de traction 89 : c = 30 limite elastique nulle 90 : c = 31 trop de points 91 : c = 32 pas assez de points 92 : c = 33 pente incorrecte 93 : c = 34 module d'young nul 94 : c = 35 manque l'origine 95 : c = 36 pente a l'origine non egale a e 96 : c = 37 manque la courbe de traction 97 : c = 38 nu devrait etre nul 98 : c 99 : c = 48 donnees erronnees pour drucker-prager 100 : c = 49 matrice singuliere dans iter internes drucker-prager 101 : c = 51 pb dans drucker prager option non disponible 102 : c = 52 pb dans drucker prager donnees incompatibles 103 : c = 53 pb dans drucker prager solution impossible 104 : c = 54 les valeurs admissibles pour istep sont 0 1 ou 2 105 : c = 55 modele non implante en non local 106 : c = 56 probleme dans l'integration du modele mazars 107 : c = 57 .... 108 : c = 58 .... 109 : c = 59 .... 110 : c = 60 pb donnees du cam-clay 111 : c 112 : c = 99 cas non encore disponible 113 : c======================================================================= 114 : * 115 : SEGMENT MPTVAL 116 : INTEGER IPOS(NS) ,NSOF(NS) 117 : INTEGER IVAL(NCOSOU) 118 : CHARACTER*16 TYVAL(NCOSOU) 119 : ENDSEGMENT 120 : * 121 : SEGMENT WRK0 122 : REAL*8 XMAT(NCXMAT) 123 : ENDSEGMENT 124 : * 125 : SEGMENT WR00 126 : CHARACTER*16 TYMAT(NCXMAT) 127 : REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT) 128 : ENDSEGMENT 129 : * 130 : SEGMENT WRK1 131 : REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS) 132 : REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI) 133 : REAL*8 DEFP(NSTRS),XCAR(ICARA) 134 : ENDSEGMENT 135 : * 136 : SEGMENT WRK2 137 : REAL*8 TRAC(LTRAC) 138 : ENDSEGMENT 139 : * 140 : SEGMENT WRK22 141 : REAL*8 XXE(3,NBNN) 142 : ENDSEGMENT 143 : * 144 : SEGMENT WRK3 145 : REAL*8 WORK(LW),WORK2(LW2) 146 : ENDSEGMENT 147 : * 148 : SEGMENT WRK4 149 : REAL*8 XE(3,NBBB) 150 : ENDSEGMENT 151 : * 152 : SEGMENT WRK5 153 : REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS) 154 : ENDSEGMENT 155 : * 156 : SEGMENT WRK6 157 : REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS) 158 : REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS) 159 : REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS) 160 : ENDSEGMENT 161 : * 162 : SEGMENT WRK7 163 : REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB) 164 : ENDSEGMENT 165 : * 166 : SEGMENT WRK8 167 : REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS) 168 : ENDSEGMENT 169 : * 170 : SEGMENT WRK9 171 : REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX) 172 : REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1) 173 : REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO) 174 : REAL*8 SIGY(NSIGY) 175 : INTEGER NKX(NNKX) 176 : ENDSEGMENT 177 : * 178 : SEGMENT WR10 179 : INTEGER IABLO1(NTABO1) 180 : REAL*8 TABLO2(NTABO2) 181 : ENDSEGMENT 182 : * 183 : SEGMENT WR11 184 : INTEGER IABLO3(NTABO3) 185 : REAL*8 TABLO4(NTABO4) 186 : ENDSEGMENT 187 : * 188 : SEGMENT WR12 189 : REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3)) 190 : REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6)) 191 : REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9)) 192 : REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS) 193 : REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS) 194 : REAL*8 SM8(NSTRS) 195 : ENDSEGMENT 196 : * 197 : SEGMENT WTRAV 198 : REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT) 199 : REAL*8 VALCAR(NUCAR),DSIGT(NSTRS) 200 : REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK) 201 : REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM) 202 : REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK) 203 : ENDSEGMENT 204 : * 205 : SEGMENT WPOUT 206 : REAL*8 X(2),Y(2),Z(2) 207 : ENDSEGMENT 208 : * 209 : * Commun NECOU utilisé dans ECOINC 210 : * 211 : COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 212 : . ITYP,IFOURB,IFLUAG, 213 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 214 : . JFLUAG,KFLUAG,LFLUAG, 215 : . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 216 : * 217 : * Commun IECOU: sert de fourre-tout pour les initialisations 218 : * d'entiers 219 : * 220 : COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK, 221 : . NYALF1,NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND, 222 : . NSOM,NINV,NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT, 223 : . LTRAC,MFR,IELE,NHRM,NBNN,NBELEM,ICARA, 224 : . LW2,NDEF,NSTRSS,MFR1,NBGMAT,NELMAT,MSOUPA, 225 : . NUMAT1,LENDO,NBBB,NNVARI,KERR1,MELEME, 226 : . icou45,icou46,icou47,icou48,icou49,icou50, 227 : . icou51,icou52,icou53,icou54,icou55,icou56 228 : . icou57,icou58 229 : * 230 : * Commun XECOU: sert de fourre-tout pour les initialisations 231 : * de réels 232 : * 233 : COMMON/XECOU/DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP0 234 : * 235 : LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC 236 : LOGICAL LUNI1,LUNI2 237 : DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12) 238 : DIMENSION NWA(9) 239 : DIMENSION SIG01(4),VAR01(36) 240 : * 241 : CHARACTER*72 CHARRE 242 : CHARACTER*8 CMATE 243 : c 244 : * 245 : * mise à disposition des temperatures tini tfin tref 246 : * aux points de gauss 247 : * 248 : TETA1=-1.E35 249 : TETA2=-1.E35 250 : TETREF=-1.E35 251 : TREFA=-1.E35 252 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 253 : MCHAM3=IPH1 254 : MCHAM4=IPH2 255 : MCHAM5=IPH3 256 : SEGACT MCHAM3 257 : SEGACT MCHAM4 258 : SEGACT MCHAM5 259 : MELVA3=MCHAM3.IELVAL(1) 260 : MELVA4=MCHAM4.IELVAL(1) 261 : MELVA5=MCHAM5.IELVAL(1) 262 : SEGACT MELVA3 263 : SEGACT MELVA4 264 : SEGACT MELVA5 265 : ENDIF 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 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 287 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 288 : 1 .OR.MFR.EQ.33)) THEN 288 : CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1) 289 : MINTE2=IPTR1 290 : SEGACT MINTE2 291 : SEGINI WRK22 292 : ENDIF 293 : c 294 : IF (LOGVIS) SEGINI WRK8 295 : SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5 296 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN 297 : SEGINI WRK4 298 : ENDIF 299 : c 300 : SEGINI WTRAV 301 : * 302 : * 303 : * boucle sur les elements 304 : * 305 : DO 1000 IB=1,NBELEM 306 : * 307 : * Matériaux orthotropes, anisotropes et unidirectionnels 308 : * en formulation massive: 309 : * - on cherche les coordonnees des noeuds de l element ib 310 : * - calcul des axes locaux 311 : * Cas particulier de l'ACIER_UNI 312 : * 312 : CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1, 313 : . MELEME,WRK4,WRK22,WTRAV) 314 : * 315 : * 316 : * boucle sur les points de gauss 317 : * 318 : DO 1100 IGAU=1,NBPTEL 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 : * en cas de reels, on a directement les valeurs 336 : * en cas d'objets, on a les pointeurs eu guise de valeurs 337 : * et on calcule les contraintes effectives en milieu poreux 338 : * 338 : CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS, 339 : . IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2, 340 : . WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB, 341 : . BID,BID2,KERR0) 342 : IF (KERR0.EQ.99) THEN 343 : KERRE=99 344 : GOTO 1000 345 : ELSE IF (KERR0.EQ.10) THEN 346 : GOTO 1000 347 : ENDIF 348 : * 349 : * 350 : * >>>>>>>>>> fin du traitement du materiau 351 : * 352 : * on recupere les caracteristiques geometriques 353 : * 353 : CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR, 354 : . WRK1) 355 : * 356 : * 357 : * quelques impressions si iimpi = 99 358 : * 359 : IF(IIMPI.EQ.99) THEN 360 : * WRITE(IOIMP,66770) IB,IGAU 361 : *66770 format(////////2x,'element ',i6,2x,'point ',i3//) 362 : * WRITE(IOIMP,66771) MATE,INPLAS 363 : *66771 format('0 mate=',i4,2x,'inplas=',i4/) 364 : * WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS) 365 : *66772 format(2x,' sig0 '/(6(1x,1pe12.5))) 366 : * WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI) 367 : *66773 format(2x,' var0 '/(6(1x,1pe12.5))) 368 : * WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS) 369 : *66774 format(2x,' depst '/(6(1x,1pe12.5))) 370 : WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT) 371 : 66775 format(2x,' xmat '/(6(1x,1pe12.5))) 372 : * IF(IVACAR.NE.0)THEN 373 : * WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA) 374 : *66776 format(2x,' xcar '/(6(1x,1pe12.5))) 375 : * ENDIF 376 : ENDIF 377 : * 378 : * mise à disposition des temperatures tini tfin tref 379 : * aux points de gauss 380 : * 381 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 382 : IBMN=MIN(IB,MELVA3.VELCHE(/2)) 383 : IGMN=MIN(IGAU,MELVA3.VELCHE(/1)) 384 : TETA1=MELVA3.VELCHE(IGMN,IBMN) 385 : IBMN=MIN(IB,MELVA4.VELCHE(/2)) 386 : IGMN=MIN(IGAU,MELVA4.VELCHE(/1)) 387 : TETA2=MELVA4.VELCHE(IGMN,IBMN) 388 : IBMN=MIN(IB,MELVA5.VELCHE(/2)) 389 : IGMN=MIN(IGAU,MELVA5.VELCHE(/1)) 390 : TETREF=MELVA5.VELCHE(IGMN,IBMN) 391 : ENDIF 392 : * 393 : * 394 : *--------------------------------------------------------------------- 395 : * 396 : * ecoulement 397 : * 398 : *--------------------------------------------------------------------- 399 : IF (INPLAS.EQ.65) THEN 400 : * 401 : SEGINI WRK7 402 : SEGINI WRK9 403 : IF((MFR.EQ.1).AND.(IFOMOD.EQ.2)) THEN 404 : IBIDO = 19 405 : ELSE 406 : IBIDO = 14 407 : ENDIF 408 : * CAS OU ON NE PREND PAS EN COMPTE LA TEMPERATURE DE TRANSITION 409 : * CAD LORSQUE TTRAN = 0 410 : * 411 : IF ((XMAT(IBIDO).LE.0.1).AND.(XMAT(IBIDO).GE.-0.1)) THEN 412 : * 413 : * si le point de gauss est déjà endommagé par endommagement généralisé 414 : * on le traite simplement par ceraca 415 : IF (VAR0(NVARI-1).EQ.1) THEN 415 : CALL CERACA(WRK0,WRK1,WRK5,WTRAV,INPLAS,MFR1,DT,NSTRSS, 416 : 1 NVARI,PRECIS,MSOUPA,JECHER,DTT,NSSINC,INV,KERRE, 417 : 2 ICARA,IFOURB,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST, 418 : 3 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK, 419 : 4 CRIGI) 420 : IND=1 421 : ELSE 422 : * si le point de gauss n'a pas un endommagement généralisé 423 : * on regarde si il a été fissuré 424 : * par ottosen et si non on applique le fluage puis ottosen 425 : * si oui on le traite par Ottosen 426 : MPTVAL=IVAMAT 426 : CALL OTOBO(VAR0,XMAT,IVAL,ITOTO,MFR) 427 : IF (ITOTO.EQ.0) THEN 427 : CALL CERACA(WRK0,WRK1,WRK5,WTRAV,INPLAS,MFR1,DT,NSTRSS, 428 : 1 NVARI,PRECIS,MSOUPA,JECHER,DTT,NSSINC,INV, 429 : 2 KERRE,ICARA,IFOURB,CMATE,N2EL,N2PTEL,IB,IGAU, 430 : 3 EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT, 431 : 4 LHOOK,CRIGI) 432 : IND=1 433 : * Ligne suivante à supprimer 434 : * IF(IND.EQ.0) THEN 435 : * on regarde si on a eu endommagement généralisé 436 : * si on n'a pas eu endommagement généralisé on appele ottosen 437 : IF (VARF(NVARI-1).NE.1) THEN 438 : DO 161 I = 1,NVARI 439 : VAR01(I) = VARF(I) 440 : 161 CONTINUE 441 : DO 535 I=1,NSTRS 442 : * PRINT *,'DEPST EPINF-EPIN0 ',I,DEPST(I),(EPINF(I)-EPIN0(I)) 443 : DEPST(I) = DEPST(I) -( EPINF(I)-EPIN0(I)) 444 : C On remplace SIGF par SIG0 445 : SIG01(I) = SIG0(I) 446 : 535 CONTINUE 447 : MPTVAL=IVAMAT 447 : CALL OTTOSE(INPLAS,SIG01,NSTRSS,DEPST,VAR01,XMAT,IVAL, 448 : & NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE, 449 : & IB,IGAU) 450 : DO 541 I=1,NSTRS 451 : 541 CONTINUE 452 : C on met à jour le variable interne EPSE commune aux deux modèles 453 : VARF(1) = VARF(1)+VARF(NVARI) 454 : C DO 537 I=1,NSTRS 455 : C IF (SIGF(I).NE.SIG01(I)) THEN 456 : C PRINT *,'DIF CONTRAINTES',I,SIGF(I),SIG01(I) 457 : C ENDIF 458 : 537 CONTINUE 459 : DO 538 I=1,NVARI 460 : C IF (VARF(I).NE.VAR01(I)) THEN 461 : C PRINT *,'DIF VARIABLES',I,VARF(I),VAR01(I) 462 : C ENDIF 463 : 538 CONTINUE 464 : 465 : 466 : 467 : C On calcule l'increment de déformation du pas de temps 468 : DO 536 I=1,NSTRS 469 : C IF (DEFP(I).NE.0.) PRINT *,'DEFP',DEFP(I) 470 : DEFP(I) =DEFP(I)+( EPINF(I)-EPIN0(I)) 471 : 536 CONTINUE 472 : IND=0 473 : ENDIF 474 : * Ligne suivante à supprimer 475 : * ENDIF 476 : ELSE 477 : MPTVAL=IVAMAT 477 : CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL, 478 : & NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE, 479 : & IB,IGAU) 480 : VARF(1) = VARF(1)+VARF(NVARI) 481 : IND=0 482 : ENDIF 483 : ENDIF 484 : 485 : * 486 : ELSE 487 : * 488 : * CAS OU ON PREND EN COMPTE LA TEMP2RATURE DE TRANSITION 489 : * 490 : IF(TETA2.GE.XMAT(IBIDO)) THEN 491 : MPTVAL=IVAMAT 491 : CALL OTOBO(VAR0,XMAT,IVAL,ITOTO,MFR) 492 : IF (ITOTO.EQ.0) THEN 492 : CALL CERACA(WRK0,WRK1,WRK5,WTRAV,INPLAS,MFR1,DT,NSTRSS, 493 : 1 NVARI,PRECIS,MSOUPA,JECHER,DTT,NSSINC,INV, 494 : 2 KERRE,ICARA,IFOURB,CMATE,N2EL,N2PTEL,IB,IGAU, 495 : 3 EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT, 496 : 4 LHOOK,CRIGI) 497 : IND=1 498 : ELSE 499 : MPTVAL=IVAMAT 499 : CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL, 500 : & NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE, 501 : & IB,IGAU) 502 : VARF(1) = VARF(1)+VARF(NVARI) 503 : IND=0 504 : ENDIF 505 : ELSE 506 : IF (VAR0(NVARI-1).EQ.1) THEN 506 : CALL CERACA(WRK0,WRK1,WRK5,WTRAV,INPLAS,MFR1,DT,NSTRSS, 507 : 1 NVARI,PRECIS,MSOUPA,JECHER,DTT,NSSINC,INV,KERRE, 508 : 2 ICARA,IFOURB,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST, 509 : 3 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK, 510 : 4 CRIGI) 511 : IND=1 512 : ELSE 513 : MPTVAL=IVAMAT 513 : CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL, 514 : & NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE, 515 : & IB,IGAU) 516 : VARF(1) = VARF(1)+VARF(NVARI) 517 : IND=0 518 : ENDIF 519 : ENDIF 520 : ENDIF 521 : IF (MFR1.EQ.17) THEN 522 : IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN 522 : CALL ERREUR(KERREU1) 523 : ENDIF 524 : ENDIF 525 : 526 : SEGSUP WRK7 527 : SEGSUP WRK9 528 : DTOPTI = MIN(DTOPTI,DTT) 529 : NINCMA = MAX(NINCMA,NSSINC) 530 : NCOMP = NCOMP + 1 531 : TSOM = TSOM + DTT 532 : NSOM = NSOM + NSSINC 533 : NINV = NINV + INV 534 : TCAR = TCAR + DTT* DTT 535 : IF(KERRE.NE.0.AND.KERRE.NE.99) THEN 536 : KERR1=1 537 : ENDIF 538 : c 539 : 540 : 541 : ELSE IF (INPLAS.EQ.74) THEN 542 : * 543 : 544 : * CHAINE DE MAXWELL 545 : * 546 : * on commence par recuperer le nombre d'elements dans la chaine 547 : * et les proprietes et variables internes associees a des objets 547 : CALL MAXTRA(WRK0,WRK1,WRK5,WR12,WTRAV,IB,IGAU, 548 : & NBGMAT,NELMAT,NPINT,NWA,NSTRSS,NCHAIN,CMATE,MFR) 549 : IF(IERR.NE.0) THEN 550 : SEGSUP WR12 551 : GOTO 1789 552 : ENDIF 553 : 554 : 555 : IF (MFR.EQ.3.OR.MFR.EQ.39) THEN 555 : CALL MAXGEN(WRK0,WRK1,WRK5,WR12,MFR, 556 : 1 IB,IGAU,MELE,NCHAIN,KERRE,DT,CMATE,NWA,TEMP0) 557 : ELSE 558 : 559 : 560 : * 561 : * MLR 10/08/99 562 : * 563 : * ON PASSE LE SEGMENT DE TRAVAIL WTRAV 564 : * 564 : CALL MAXWEL(WRK0,WRK1,WRK5,WR12,MFR, 565 : + IB,IGAU,MELE,NCHAIN,KERRE,DT,CMATE,NWA,TEMP0) 566 : ENDIF 567 : * 568 : * ici gerer les erreurs 569 : * 569 : CALL MAXTRB(WTRAV,WRK1,WRK5,WR12,NWA,NSTRSS, 570 : & NCHAIN,CMATE) 571 : SEGSUP WR12 572 : * 573 : * FIN DES DIFFERENTS MODELES 574 : * 575 : ELSE 576 : KERRE = 99 577 : ENDIF 578 : * 579 : * Erreurs 580 : * - problèmes de convergence 581 : * 581 : 1789 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 610 : c remplissage du segment contenant les contraintes a la fin 611 : * ( rearrangement pour milieu poreux ), 612 : c les variables internes finales 613 : c et les increments de deformations plastiques 614 : c 614 : CALL DEFSIG(MFR,NDEF, 615 : . INPLAS,IND,WRK1,WRK5,WTRAV, 616 : . IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU, 617 : . CMATE,MATE,MELE,KERRER) 618 : IF (KERRER.NE.0) GOTO 1000 619 : c 620 : c fin de la boucle sur les points de gauss 621 : c 622 : 1100 continue 623 : c 624 : c special poutres et tuyaux sauf timoschenko 625 : c 625 : CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF) 626 : c 627 : c fin de la boucle sur les elements 628 : c 629 : 1000 continue 630 : c 631 : * FIN: modèles visqueux, on stocke le pas de temps 632 : * optimal en indice 'dtopti' 633 : * 633 : CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA, 634 : . TCAR,DTOPTI,IPOTAB,KERRE) 635 : IF (LOGVIS) SEGSUP WRK8 636 : * 637 : * 638 : SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV 639 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN 640 : SEGSUP WRK4 641 : END IF 642 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 643 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 644 : 1 .OR.MFR.EQ.33)) THEN 645 : SEGDES MINTE2 646 : SEGSUP WRK22 647 : ENDIF 648 : * 649 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 650 : SEGDES MELVA3 651 : SEGDES MELVA4 652 : SEGDES MELVA5 653 : SEGDES MCHAM3 654 : SEGDES MCHAM4 655 : SEGDES MCHAM5 656 : ENDIF 657 : * 658 : RETURN 659 : END 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 : 686 : 687 : 688 : 689 : 690 : 691 : 692 : 693 :
© Cast3M 2003 - All rights reserved.
Disclaimer