1 : C ECOU70 SOURCE CHAT 11/03/16 21:20:15 6902 2 : SUBROUTINE ECOU70(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,NMATR,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: -PLASTIQUES NON INTEGRES PAR ECOINC 11 : * suite de ECOU60 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,NBNN) 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 : REAL*8 LCAR 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 : **************************** 259 : * SPECIAL SUCCION 260 : * 261 : SUCC1=-1.E35 262 : SUCC2=-1.E35 263 : IF (ITHHER.EQ.3) THEN 264 : MCHAM3=IPH1 265 : MCHAM4=IPH2 266 : SEGACT MCHAM3 267 : SEGACT MCHAM4 268 : MELVA3=MCHAM3.IELVAL(1) 269 : MELVA4=MCHAM4.IELVAL(1) 270 : SEGACT MELVA3 271 : SEGACT MELVA4 272 : ENDIF 273 : **************************** 274 : c 275 : c Initialisations de variables 276 : c--------------------------------- 277 : c - mise à zéro des variables du commun NECOU si besoin 278 : c - modèles viscoplastiques: 279 : c . on récupère le pas de temps 280 : c . on récupère le nombre maximal de sous-pas 281 : c . on met IND=1 282 : c - initialisation des dimensions des tableaux des segments 283 : c Sorties: en plus du commun NECOU, on range les autres données 284 : c initialisées dans les COMMON IECOU et XECOU 285 : c Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme 286 : c argument de DEFINI 287 : c 287 : CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE, 288 : . ISTEP,INPLAS,NPINT,IPOTAB,IVADEF, 289 : . IPMAIL,IVAMAT, 290 : . ITHHER,NUMAT,NUCAR,LOGVIS, 291 : . LUNI1,LUNI2,LW,KERRE) 292 : IF (KERRE.EQ.999) RETURN 293 : c 294 : c Initialisations des segments de travail 295 : c 296 : c 297 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 298 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 299 : 1 .OR.MFR.EQ.33)) THEN 299 : CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1) 300 : MINTE2=IPTR1 301 : SEGACT MINTE2 302 : SEGINI WRK22 303 : ENDIF 304 : c 305 : IF (LOGVIS) SEGINI WRK8 306 : SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5 307 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1.OR.INPLAS.EQ.66) THEN 308 : SEGINI WRK4 309 : ENDIF 310 : c 311 : SEGINI WTRAV 312 : * 313 : * 314 : * boucle sur les elements 315 : * 316 : DO 1000 IB=1,NBELEM 317 : * 318 : * Matériaux orthotropes, anisotropes et unidirectionnels 319 : * en formulation massive: 320 : * - on cherche les coordonnees des noeuds de l element ib 321 : * - calcul des axes locaux 322 : * Cas particulier de l'ACIER_UNI 323 : * 323 : CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1, 324 : . MELEME,WRK4,WRK22,WTRAV) 325 : * 326 : IF(INPLAS.EQ.66) THEN 326 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 327 : ENDIF 328 : * 329 : * CALCUL DE LA LONGUEUR CARACTERISTIQUE DE L'éLéMENT COURANT 330 : * POUR MODèLE BETON URGC INSA 331 : * 332 : 333 : IF(INPLAS.GE.99.AND.INPLAS.LE.101) THEN 333 : CALL LONGCA(IPMAIL,IB,LCAR) 334 : ENDIF 335 : 336 : * 337 : * boucle sur les points de gauss 338 : * 339 : DO 1100 IGAU=1,NBPTEL 340 : * 341 : * -recuperation de valmat et de valcar 342 : * -on recupere les contraintes initiales 343 : * -on recupere les variables internes 344 : * -on recupere les deformations inelastiques initiales si besoin 345 : * -on recupere les increments de deformations totales 346 : * -on cherche la section de l'element ib 347 : * -prise en compte de l'epaisseur et de l'excentrement 348 : * dans le cas des coques minces avec ou sans cisaillement 349 : * transverse 350 : * 350 : CALL DEFVAL(NUMAT1,NBPTEL,NDEF, 351 : . IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET, 352 : . IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND, 353 : . WTRAV,WRK1,WRK5,SECT,EPAIST) 354 : * 355 : * on recupere les constantes du materiau 356 : * calcul des contraintes effectives en milieu poreux 357 : * 357 : CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS, 358 : . IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2, 359 : . WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB, 360 : . BID,BID2,KERR0) 361 : IF (KERR0.EQ.99) THEN 362 : KERRE=99 363 : GOTO 1000 364 : ELSE IF (KERR0.EQ.10) THEN 365 : GOTO 1000 366 : ENDIF 367 : * 368 : * >>>>>>>>>> fin du traitement du materiau 369 : * 370 : * on recupere les caracteristiques geometriques 371 : * 371 : CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR, 372 : . WRK1) 373 : * 374 : * 375 : * quelques impressions si iimpi = 99 376 : * 377 : * IF(IIMPI.EQ.99) THEN 378 : * WRITE(IOIMP,66770) IB,IGAU 379 : *66770 format(////////2x,'element ',i6,2x,'point ',i3//) 380 : * WRITE(IOIMP,66771) MATE,INPLAS,NMATT,NVARI 381 : *66771 format('0 mate=',i4,' inplas=',i4,' nmatt=',i4,' nvari=',i4/) 382 : * WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS) 383 : *66772 format(2x,' sig0 '/(6(1x,1pe12.5))) 384 : * WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI) 385 : *66773 format(2x,' var0 '/(6(1x,1pe12.5))) 386 : * WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS) 387 : *66774 format(2x,' depst '/(6(1x,1pe12.5))) 388 : * WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT) 389 : *66775 format(2x,' xmat '/(6(1x,1pe12.5))) 390 : * IF(IVACAR.NE.0)THEN 391 : * WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA) 392 : *66776 format(2x,' xcar '/(6(1x,1pe12.5))) 393 : * ENDIF 394 : * ENDIF 395 : * 396 : * mise à disposition des temperatures tini tfin tref 397 : * aux points de gauss 398 : * 399 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 400 : IBMN=MIN(IB,MELVA3.VELCHE(/2)) 401 : IGMN=MIN(IGAU,MELVA3.VELCHE(/1)) 402 : TETA1=MELVA3.VELCHE(IGMN,IBMN) 403 : IBMN=MIN(IB,MELVA4.VELCHE(/2)) 404 : IGMN=MIN(IGAU,MELVA4.VELCHE(/1)) 405 : TETA2=MELVA4.VELCHE(IGMN,IBMN) 406 : IBMN=MIN(IB,MELVA5.VELCHE(/2)) 407 : IGMN=MIN(IGAU,MELVA5.VELCHE(/1)) 408 : TETREF=MELVA5.VELCHE(IGMN,IBMN) 409 : ENDIF 410 : **************************** 411 : * SPECIAL SUCCION 412 : * 413 : IF (ITHHER.EQ.3) THEN 414 : IBMN=MIN(IB,MELVA3.VELCHE(/2)) 415 : IGMN=MIN(IGAU,MELVA3.VELCHE(/1)) 416 : SUCC1=MELVA3.VELCHE(IGMN,IBMN) 417 : IBMN=MIN(IB,MELVA4.VELCHE(/2)) 418 : IGMN=MIN(IGAU,MELVA4.VELCHE(/1)) 419 : SUCC2=MELVA4.VELCHE(IGMN,IBMN) 420 : ENDIF 421 : **************************** 422 : * 423 : *--------------------------------------------------------------------- 424 : * 425 : * ecoulement selon les modeles 426 : * 427 : *--------------------------------------------------------------------- 428 : * 429 : MPTVAL=IVAMAT 430 : IF (INPLAS.EQ.66) THEN 431 : C 432 : C 433 : C modele BETON_INSA_LYON CYCLIQUE : CONTRAINTES PLANES, 434 : C DEFORMATION PLANES ET AXISYMETRIE 435 : C 436 : iwrk12=0 436 : CALL BEINSA(SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL,NMATT, 437 : 1 SIGF,VARF,KERRE,MELE,IFOURB,NVARI,XCAR,NCARR,MFR, 438 : 2 EPIN0,EPINF,DT,XE,NBNN,CMATE,IB,IGAU,iwrk12) 439 : * 440 : * 441 : ELSEIF (INPLAS.EQ.67) THEN 442 : C 443 : C modele ECROUIS_INSA (Materiau ORTHOTROPE ECROUISSABLE DECOUPLE) 444 : C 445 : MVEL1= nint(XMAT(NMATR)) 445 : CALL COTROR(WRK0,WRK2,NCOURB,MVEL1,KERRE) 446 : LT1=NCOURB*2 446 : CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT, 447 : 1 TRAC,LT1,MFR,NVARI,CMATE,XCAR,DDHOOK,NCARR,IFOURB) 448 : * 449 : * 450 : ELSEIF (INPLAS.EQ.68) THEN 451 : C 452 : C modele PARFAIT_INSA (Materiau ORTHOTROPE PLASTIQUE PARFAIT DECOUPLE) 453 : C 454 : NCOURB=3 455 : KERRE = 0 456 : TRAC(1)=0.D0 457 : TRAC(2)=0.D0 458 : TRAC(3)=XMAT(NMATR) 459 : TRAC(4)=XMAT(NMATR)/XMAT(1) 460 : TRAC(5)=XMAT(NMATR) 461 : TRAC(6)=1.D0 462 : IF(XMAT(NMATR).EQ.0.D0) KERRE = 33 463 : LT1=NCOURB*2 463 : CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT, 464 : 1 TRAC,LT1,MFR,NVARI,CMATE,XCAR,DDHOOK,NCARR,IFOURB) 465 : C 466 : ELSEIF (INPLAS.EQ.69) THEN 467 : C 468 : C MODELE D'ARGILE PARTIELLEMENT SATURE D'ALONSO 469 : C 470 : **************************** 471 : * SPECIAL SUCCION 472 : * 473 : nnecou=0 473 : CALL ALON1(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU, 474 : 1 XMAT,SIG0,VAR0,SIGF,VARF,DEFP,KERRE,DSIGT, 475 : 2 SUCC1,SUCC2,NNECOU) 476 : IF((KERRE.NE.0).AND.(KERRE.NE.99)) THEN 477 : KERR1=1 478 : END IF 479 : C 480 : ELSEIF (INPLAS.EQ.71) THEN 481 : C 482 : C MODELE D'ARGILE PARTIELLEMENT SATURE DE PAKZAD 483 : C 484 : inecou=0 484 : CALL PAKZAD(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU, 485 : 1 XMAT,SIG0,VAR0,SIGF,VARF,DEFP,KERRE,DSIGT, 486 : 2 SUCC1,SUCC2,inecou) 487 : IF((KERRE.NE.0).AND.(KERRE.NE.99)) THEN 488 : KERR1=1 489 : END IF 490 : **************************** 491 : C 492 : ELSEIF (INPLAS.EQ.72) THEN 493 : C 494 : C MODELE INFILL_UNI 495 : C 496 : IF (MFR.EQ.27) THEN 497 : C 498 : C ON RECUPERE LA COURBE FORCE-DEPLACEMENT 499 : C 499 : CALL COTRAI(WRK0,WRK2,12,1,0, NPOINT,KERRE) 500 : NCOURB=NPOINT/2 501 : IF(KERRE.EQ.0) THEN 501 : CALL INFILL(WRK0,WRK1,WRK2,NCOURB,KERRE) 502 : END IF 503 : ELSE 504 : KERRE = 99 505 : ENDIF 506 : C 507 : ELSE IF (INPLAS.EQ.73)THEN 508 : C 509 : C MODELE ETAGE 510 : C pour le moment, element de barre 511 : * 512 : IF (MFR.EQ.7) THEN 513 : C 514 : C ON RECUPERE LA COURBE FORCE-DEPLACEMENT 515 : C 516 : IPOS1=1 516 : CALL COTRAI(WRK0,WRK2,12,IPOS1,0, NPOINT,KERRE) 517 : NTRAP=NPOINT/2 518 : IPOS2=IPOS1+NPOINT 518 : CALL COTRAI(WRK0,WRK2,13,IPOS2,0, NPOINT,KERRE) 519 : NTRAN=NPOINT/2 520 : IF(KERRE.EQ.0) THEN 520 : CALL ETAGE(WRK0,WRK1,WRK2,NTRAP,NTRAN,KERRE) 521 : END IF 522 : ELSE 523 : KERRE = 99 524 : ENDIF 525 : C 526 : ELSEIF (INPLAS.EQ.99) THEN 527 : 528 : C 529 : C 530 : C modele BETON_URGC ELASTO PLASTIQUE: CONTRAINTES PLANES, 531 : C DEFORMATION PLANES ET AXISYMETRIE 532 : C 532 : CALL URGCST(WRK0,WRK1,WRK4,NSTRSS,NMATT, 533 : 1 KERRE,MELE,IFOURB,NCARR,MFR, 534 : 2 DT,TEMP0,CMATE,IB,IGAU,LCAR,0) 535 : c 536 : ELSEIF (INPLAS.EQ.101) THEN 537 : C 538 : C modele BETON_URGC VISCO ELASTO PLASTIQUE : CONTRAINTES PLANES, 539 : C DEFORMATION PLANES ET AXISYMETRIE 540 : C 540 : CALL URGCST(WRK0,WRK1,WRK4,NSTRSS,NMATT, 541 : 1 KERRE,MELE,IFOURB,NCARR,MFR, 542 : 2 DT,TEMP0,CMATE,IB,IGAU,LCAR,2) 543 : * 544 : C 545 : ELSE 546 : KERRE=99 547 : ENDIF 548 : * 549 : * Erreurs 550 : * - problèmes de convergence 551 : * 551 : CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC) 552 : * 553 : * - autres problèmes 554 : * 554 : 1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU, 555 : . KERR1,KERRE) 556 : IF(MFR.EQ.49.OR.INPLAS.EQ.66) THEN 557 : KERR1=0 558 : KERRE=0 559 : LOGSUC=.TRUE. 560 : ENDIF 561 : * 562 : * 563 : 1998 IF(KERRE.NE.0) THEN 564 : IF (LOGVIS) SEGSUP WRK8 565 : SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV 566 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1.OR.INPLAS.EQ.66) THEN 567 : SEGSUP WRK4 568 : ENDIF 569 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 570 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 571 : 1 .OR.MFR.EQ.33)) THEN 572 : SEGDES MINTE2 573 : SEGSUP WRK22 574 : ENDIF 575 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 576 : SEGDES MELVA3 577 : SEGDES MELVA4 578 : SEGDES MELVA5 579 : SEGDES MCHAM3 580 : SEGDES MCHAM4 581 : SEGDES MCHAM5 582 : ENDIF 583 : **************************** 584 : * SPECIAL SUCCION 585 : * 586 : IF (ITHHER.EQ.3) THEN 587 : SEGDES MELVA3 588 : SEGDES MELVA4 589 : SEGDES MCHAM3 590 : SEGDES MCHAM4 591 : ENDIF 592 : **************************** 593 : RETURN 594 : ENDIF 595 : c 596 : c remplissage du segment contenant les contraintes a la fin 597 : * ( rearrangement pour milieu poreux ), 598 : c les variables internes finales 599 : c et les increments de deformations plastiques 600 : c 600 : CALL DEFSIG(MFR,NDEF, 601 : . INPLAS,IND,WRK1,WRK5,WTRAV, 602 : . IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU, 603 : . CMATE,MATE,MELE,KERRER) 604 : IF (KERRER.NE.0) GOTO 1000 605 : c 606 : c fin de la boucle sur les points de gauss 607 : c 608 : 1100 continue 609 : c 610 : c special poutres et tuyaux sauf timoschenko 611 : c 611 : CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF) 612 : c 613 : c fin de la boucle sur les elements 614 : c 615 : 1000 continue 616 : * 617 : * FIN: modèles visqueux, on stocke le pas de temps 618 : * optimal en indice 'dtopti' 619 : * 619 : CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA, 620 : . TCAR,DTOPTI,IPOTAB,KERRE) 621 : IF (LOGVIS) SEGSUP WRK8 622 : * 623 : SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV 624 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1.OR.INPLAS.EQ.66) THEN 625 : SEGSUP WRK4 626 : ENDIF 627 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 628 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31 629 : 1 .OR.MFR.EQ.33)) THEN 630 : SEGDES MINTE2 631 : SEGSUP WRK22 632 : ENDIF 633 : * 634 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 635 : SEGDES MELVA3 636 : SEGDES MELVA4 637 : SEGDES MELVA5 638 : SEGDES MCHAM3 639 : SEGDES MCHAM4 640 : SEGDES MCHAM5 641 : ENDIF 642 : **************************** 643 : * SPECIAL SUCCION 644 : * 645 : IF (ITHHER.EQ.3) THEN 646 : SEGDES MELVA3 647 : SEGDES MELVA4 648 : SEGDES MCHAM3 649 : SEGDES MCHAM4 650 : ENDIF 651 : **************************** 652 : * 653 : RETURN 654 : END 655 : 656 : 657 : 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 : 686 : 687 : 688 : 689 :
© Cast3M 2003 - All rights reserved.
Disclaimer