1 : C ECOINC SOURCE AM 13/12/16 21:15:27 7825 2 : SUBROUTINE ECOINC(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL, 3 : . N2PTEL,VARIN0,VAREX0,VAREXF,XMAT,PRECIS,WORK,CARAC,TRAC, 4 : . SIGF,VARINF,DEFP,KERRE,MFR,IB,IGAU,NSTRS,EPAIST,MELE,NPINT, 5 : . NBPGAU,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK, 6 : . ROTHOO,DDHOMU,CRIGI,DSIGT,INPLAS) 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : C--------------------------------------------------------------------- 10 : C ECOULEMENT PLASTIQUE POUR UN POINT 11 : C D 'APRES INCA 12 : C--------------------------------------------------------------------- 13 : C 14 : C EN ENTREE : 15 : C 16 : C SIG0 CONTRAINTES AU DEBUT DU PAS 17 : C DEPST INCREMENT DE DEFORMATIONS TOTALES 18 : C ( THERMIQUE ENLEVEE ) 19 : C VARIN0 VARIABLES INTERNES DEDUT DU PAS 20 : C VAREX0 VARIABLES EXTERNES DEBUT DU PAS 21 : C VAREXF VARIABLES EXTERNES FIN DU PAS 22 : C XMAT COEFFICIENTS DU MATERIAU 23 : C PRECIS PRECISION POUR ITERATIONS INTERNES 24 : C CARAC DES CARACTERISTIQUES 25 : C TRAC COURBE DE TRACTION 26 : C MFR INDICE DE FORMULATION 27 : C NSTRS NOMBRE DE CONTRAINTES CA2000 28 : C INPLAS NUMERO DU MODELE DE PLASTICITE 29 : * DDAUX = MATRICE DE HOOKE ELASTIQUE 30 : * CMATE = NOM DU MATERIAU 31 : * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU 32 : * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES 33 : * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE 34 : * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE 35 : * IFOU = OPTION DE CALCUL 36 : * IB = NUMERO DE L ELEMENT COURANT 37 : * IGAU = NUMERO DU POINT COURANT 38 : * EPAIST= EPAISSEUR 39 : * NBPGAU= NBRE DE POINTS DE GAUSS 40 : * MELE = NUMERO DE L ELEMENT FINI 41 : * NPINT = NBRE DE POINTS D INTEGRATION 42 : * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES 43 : * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES 44 : * SECT = SECTION 45 : * LHOOK = TAILLE DE LA MATRICE DE HOOKE 46 : * TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX UTILISES 47 : * UTILISES POUR LE CALCUL DE LA MATRICE DE HOOKE 48 : C 49 : C EN SORTIE : 50 : C 51 : C SIGF CONTRAINTES A LA FIN DU PAS 52 : C VARINF VARIABLES INTERNES FIN DU PAS 53 : C DEFP INCR. DE DEFORMATIONS PLASTIQUES 54 : C KERRE CODE D'ERREUR 55 : C = 0 SI TOUT OK 56 : C = 99 SI FORMULATION NON DISPONIBLE 57 : C EN PLASTICITE 58 : C = 1 SI DEPS EST NEGATIF 59 : C = 2 SI NOMBRE MAX D'ITERATIONS INTERNES DEPASSE 60 : C EN FLUAGE 61 : C = 3 DIMINUER LE PAS ( FLUAGE RUNGE ) 62 : C = 4 DEPS EST NEGATIF 63 : C = 5 PAS DE CONVERGENCE INTERNE ( ANCIEN NSTOP=0 ) 64 : C = 6 MATRICE SINGULIERE DANS CHAFLU 65 : C EN PLUS 66 : C = 7 PROBLEME DANS LES CARACT DU TUYAU 67 : C = 49 PB DANS LES ITER. INTERNES DRUCKER-PRAGER 68 : C = 51 PB DANS LES ITER. INTERNES DRUCKER-PRAGER 69 : C = 52 PB DANS LES ITER. INTERNES DRUCKER-PRAGER 70 : C = 53 PB DANS LES ITER. INTERNES DRUCKER-PRAGER 71 : C = 75 PB AVEC LA COURBE DE TRACTION 72 : C 73 : C----------------------------------------------------------------------- 74 : C VARIABLES PASSEES PAR LES COMMON ECOU ET NECOU 75 : C 76 : C IFOUR INDICE DU TYPE DE PROBLEME 77 : C -2 CONTRAINTES PLANES 78 : C -1 DEFORMATIONS PLANES 79 : C 0 80 : C N SERIE DE FOURIER 81 : C IMAPLA INDICE DE MATERIAU PLASTIQUE 82 : C 0 MATERIAU ELASTIQUE 83 : C 4 MODELE DE CHABOCHE 84 : C 5 MODELE DE DRUCKER-PRAGER 85 : C 7 MODELE DE ROUSSELIER 86 : C ITYP TYPE DE FORMULATION MECANIQUE 87 : C ITYP=1 CAS DES ELEMENTS MASSIFS 88 : C ITYP=2 CAS DES COQUES 89 : C ITYP=3 CAS DES MEMBRANES 90 : C ITYP=4 CAS DES CABLES ET DES BARRES 91 : C ITYP=5 CAS QUELCONQUE 92 : C ITYP=6 CAS DES CONTRAINTES PLANES 93 : C ITYP=7 CAS DES COQUES A NU=0. OU CONTRAINTES PLANES 94 : C ITYP=8 CAS DES MEMBRANES A NU=0. OU CONTRAINTES PLANES C ITYP=9 CAS DES COQUES EPAISSES 95 : C ITYP=10 CAS DES JOINTS 96 : C ITYP=11 CAS DES POUTRES 97 : C ITYP=12 CAS DES TUYAUX 98 : C ITYP=13 CAS DES COQUES AVEC CISAILLEMENT TRANSVERSE 99 : C IBI 1 SI ERREUR DANS TRACTI , 0 SINON 100 : C IPLAST 1 SI ON A PLASTIFIE , 0 SINON 101 : C ICINE = 1 ECROUISSAGE CINEMATIQUE ( CHABOCHE COMPRIS ) 102 : C JFLUAG = 1 ON FLUE AVEC SIGMA 103 : C JFLUAG = 2 ON FLUE AVEC (SIG-X) 104 : C LFLUAG = 0 ON ECROUIT EN CAS DE FLUAGE 105 : C LFLUAG = 1 ON N'ECROUIT PAS EN CAS DE FLUAGE 106 : C JNTRIN = 0 LE TEMPS INTRINSEQUE EST LE TEMPS REEL 107 : C JNTRIN = 1 ON EVOLUE LE TEMPS INTRINSEQUE EN PLASTICITE ET FLUAGE 108 : C JNTRIN = 2 ON N'EVOLUE LE TEMPS INTRINSEQUE QU'EN FLUAGE 109 : C JNTRIN = 3 ON EST EN PLASTICITE ISOCHRONE 110 : C 111 : C TETI = TEMPERATURE AU DEBUT DU PAS 112 : C TET = TEMPERATURE A LA FIN DU PAS 113 : C----------------------------------------------------------------------- 114 : -INC CCOPTIO 115 : COMMON/ECOU/TEST,ALFAH, 116 : 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 117 : 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 118 : 1 DALPHA(6),EPSPLA(6),E(12),XINV(3), 119 : 2 SIPLAD(6),DSIGP0(6),TET,TETI 120 : C 121 : COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 122 : . ITYP,IFOURB,IFLUAG, 123 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 124 : . JFLUAG,LEGAUS,LFLUAG, 125 : . IRELAX,JNTRIN,MFLUAG,JELEM,JGRDEF 126 : C 127 : DIMENSION SIG0(*),DEPST(*),SIGF(*),VARIN0(*),VARINF(*),XMAT(*), 128 : . VAREX0(*),VAREXF(*),DEFP(*),CARAC(*),TRAC(*),WORK(*) 129 : DIMENSION SIGMA(6),DSIGMA(6),SPHER(6),AUXIL(6),COEF(40) 130 : DIMENSION DIV(7),SIGFIN(6),DEFPLA(6),DSIGT(*) 131 : DIMENSION TABID(6),TABID2(6) 132 : DIMENSION DDAUX(LHOOK,*),TXR(IDIM,*),CRIGI(*) 133 : DIMENSION VALMAT(*),VALCAR(*),DDHOMU(LHOOK,*) 134 : DIMENSION XLOC(IDIM,*),XGLOB(IDIM,*) 135 : DIMENSION D1HOOK(LHOOK,*),ROTHOO(LHOOK,*) 136 : CHARACTER*8 CMATE 137 : C ZZZZZZZZZZZZZZZZZZZZZZZ 138 : C DIMENSIONS A REVOIR 139 : C ZZZZZZZZZZZZZZZZZZZZZ 140 : DIMENSION DHOOK(1),SIG(130),EPS(130) 141 : DIMENSION ORMAT(1),ANORM(1) 142 : DIMENSION DSIGZE(6),DETFNO(1) 143 : DATA ITMAX/15/ 144 : DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/ 145 : DATA A,B,C,D/.577350269D0,.7071067814D0,.4082482904D0, 146 : . -0.8164965808D0/ 147 : DATA A1/1.D0/ 148 : DATA A2/.5D0/ 149 : DATA A3/3.D0/ 150 : DATA COEF/0.D0,1.5D0,1.5D0,3.D0,3.D0,3.D0,0.5D0,1.5D0,3.D0,0.5D0, 151 : . 1.5D0,3.D0,0.D0,0.D0,1.D0,0.D0,0.D0,0.D0,1.D0, 152 : . 1.D0,1.D0,2.D0,2.D0,2.D0,0.5D0,1.5D0,0.D0,3.D0, 153 : . 1.D0,0.D0,0.D0,1.D0,1.D0,1.D0,0.5D0,1.5D0,0.D0,3.D0,3.D0,3.D0/ 154 : DATA XRF/0.0001D0/ 155 : C----------------------------------------------------------------------- 156 : C CONVENTION DE REMPLISSAGE DES MEMOIRES 157 : C----------------------------------------------------------------------- 158 : C 159 : C XMAT(1) MODULE D'YOUNG 160 : C XMAT(2) COEFFICIENT DE POISSON 161 : C 162 : C TRAC(1 A 2*NCOURB) COURBE DE TRACTION 163 : C CARAC( " +1) ALFAH POUR COQUES PLASTICITE GLOBALE 164 : C CARAC( " +..) DONNEES POUR CRITERE POUTRES GLOBALES 165 : C 166 : C MODELE ISOTROPE 167 : C VARIN0(1) EPS* 168 : C 169 : C MODELE CINEMATIQUE LINEAIRE 170 : C VARIN0(1) EPS* 171 : C VARIN0(2) A VARIN0(1+IBOU) DEPLACEMENT DE LA SPHERE 172 : C 173 : C MODELE CHABOCHE 174 : C XMAT(5) .... COEFFICIENTS A,C,... 175 : C VARIN0(1) EPS* 176 : C VARIN0(2) A VARIN0(1+IBOU) DEPLACEMENT DE LA SPHERE 1 177 : C VARIN0(2+IBOU) A VARIN0(1+2*IBOU) " " " " 2 178 : C ICENT2 = 1 SI ON A 2 CENTRES 179 : C 180 : C MODELE DRUCKER-PRAGER 181 : C XMAT(5) .... XMAT(13) = LES CONSTANTES DU MODELE 182 : C VARIN0(1) EPS* 183 : C 184 : C MODELE ROUSSELIER 185 : C 186 : C MODELE DE CYCLAGE 187 : C 188 : C MODELE A TEMPS INTRINSEQUE ( FLUAGE ET PLASTICITE ISOCHRONE ) 189 : C VARIN0(.) TIMEXI TEMPS INTRINSEQUE DE DEBUT DE PAS 190 : C 191 : C-------------------------------------------------------------------- 192 : C REMPLISSAGE 193 : C----------------------------------------------------------------------- 194 : YUNG=XMAT(1) 195 : XNU =XMAT(2) 196 : C 197 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 198 : C REMPLISSAGE A ACTUALISER SELON LES MODELES 199 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZ 200 : CZZZZZZZZZZZZZZZZZZZZZZ 201 : C VARIABLES A RECUPERER 202 : CZZZZZZZZZZZZZZZZZZZZZZ 203 : C ORMAT MATERIAU ORTHOTROPE DANS XMAT 204 : C ANORM A VOIR DANS XMAT OU DANS VARIN 205 : C EPENT DANS VARIN 206 : C VECPRO,VALPRO DANS XMAT 207 : C COVNMS,CVNMSD DANS XMAT ( SELON LES CAS ) 208 : C 209 : C IT DANS VAREXT 210 : C EPSFLU DANS VARINT 211 : C SIG,EPS DANS XMAT 212 : C DETFNO DANS VARIN ???? 213 : C DSIGZE DANS VARIN ( POUR FLUAGE RELAX ) 214 : C SIPLAD DANS VARIN ( POUR FLUAGE RELAX ) ... 215 : C ... ( CE SONT LES DEFORMATIONS OU CONTRAINTES (A VOIR) PLASTIQUES 216 : C AU DEBUT DU PAS ) 217 : C TEMPS , HPAS DANS VAREXT 218 : C TET,TETI DANS VAREXT 219 : C 220 : EPSM1=VARIN0(1) 221 : TIMEXI=VARIN0(1) 222 : DPSM1=VARIN0(1) 223 : DPSM2=VARIN0(1) 224 : EPENT=VARIN0(1) 225 : EPSFLU=VARIN0(1) 226 : DETFNO(1)=VARIN0(1) 227 : DSIGZE(1)=VARIN0(1) 228 : TEMPS0=VAREX0(1) 229 : IT=nint(VAREX0(3)) 230 : TEMPS=VAREXF(1) 231 : TETI=VAREX0(2) 232 : TET =VAREXF(2) 233 : IF(NCOURB.EQ.0) GO TO 5634 234 : DO 292 I=1,NCOURB 235 : SIG(I)=TRAC(2*I-1) 236 : 292 EPS(I)=TRAC(2*I) 237 : 5634 CONTINUE 238 : ORMAT(1)=XMAT(1) 239 : DHOOK(1)=XMAT(1) 240 : C---------------------------------------------------------------------- 241 : C INITIALISATIONS 242 : C---------------------------------------------------------------------- 243 : KERRE=0 244 : JA=1 245 : JC=1 246 : IA=1 247 : C 248 : C PETIT TEST SUR NU POUR CERTAINS CAS 249 : C 250 : IF(MFR.EQ.3.AND.IFOURB.EQ.-2.AND.XNU.NE.0.D0) THEN 251 : KERRE=38 252 : RETURN 253 : ENDIF 254 : CZZZZZZZZZZZZZ 255 : C PROVISOIRE 256 : CZZZZZZZZZZZZ 257 : ANORM(1)=XMAT(5) 258 : ICENT2=0 259 : IF(INPLAS.EQ.12.OR.INPLAS.EQ.13) ICENT2=1 260 : IF(INPLAS.EQ.7) NUMCHA=1 261 : IF(INPLAS.EQ.11) NUMCHA=2 262 : IF(INPLAS.EQ.12) NUMCHA=3 263 : IF(INPLAS.EQ.13) NUMCHA=4 264 : C 265 : TEST=0.5D00*PRECIS 266 : HPAS=TEMPS-TEMPS0 267 : MCOD=1 268 : * 269 : * CALCUL DE DSIGT 270 : * 270 : CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,VALCAR, 271 : 1 N2EL,N2PTEL,MFR,IFOURB,IB,IGAU,EPAIST, 272 : 2 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR, 273 : 3 XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD) 274 : * 275 : IF(IRTD.NE.1) THEN 276 : KERRE=69 277 : GOTO 1000 278 : ENDIF 279 : * 280 : * TRAITEMENT DES COQ2 ET MASSIF 2D EN CAS DE MATERIAU 281 : * UNIDIRECTIONNEL 282 : * 283 : * LES VARIABLES INTERNES SONT DANS LE REPERE UNIDIRECTIONNEL 284 : * ON SE LIMITE AU CAS AXISYMETRIQUE ? 285 : * 286 : IF (CMATE.EQ.'UNIDIREC'.AND.INPLAS.NE.0) THEN 287 : IF(MELE.EQ.44.OR.(MFR.EQ.1.AND.IFOURB.LE.0)) THEN 288 : APHI=0.D0 289 : * 290 : * CAS MASSIF : ON AJOUTE L'ANGLE DU REPERE 291 : * DE L'ELEMENT AVEC LE REPERE GLOBAL 292 : * 293 : IF(MFR.EQ.1) APHI=ATAN2(TXR(2,1),TXR(1,1)) 294 : DO 1996 I=1,NSTRS 295 : TABID(I)=SIG0(I) 296 : TABID2(I)=DSIGT(I) 297 : 1996 CONTINUE 298 : ANG = ATAN2(XMAT(4),XMAT(3)) + APHI 298 : CALL CHREP2(TABID,SIG0,ANG,NSTRS,MFR,1,KERRE) 298 : CALL CHREP2(TABID2,DSIGT,ANG,NSTRS,MFR,1,KERRE) 299 : IF(KERRE.NE.0) RETURN 300 : ELSEIF(MFR.EQ.1.AND.IFOURB.EQ.2) THEN 301 : DO 996 I=1,NSTRS 302 : TABID(I)=SIG0(I) 303 : TABID2(I)=DSIGT(I) 304 : 996 CONTINUE 304 : CALL CHREP3(TABID,SIG0,XMAT,TXR,NSTRS,1,1,KERRE) 304 : CALL CHREP3(TABID2,DSIGT,XMAT,TXR,NSTRS,1,1,KERRE) 305 : 306 : ENDIF 307 : ENDIF 308 : * 309 : iecou=0 310 : inecou=0 310 : CALL VISAVI(SIG0,DSIGT,VARIN0,SIGMA,DSIGMA,SPHER,AUXIL, 311 : . SIGF,DEFP,VARINF,SIGFIN,DEFPLA, 312 : . DSIGZE,ICENT2,MCOD,IBOU,MFR,NSTRS,CARAC,CMATE 313 : > ,iecou,inecou) 314 : 315 : IF(ITYP.EQ.0) THEN 316 : KERRE=99 317 : RETURN 318 : ENDIF 319 : C----------------------------------------------------------------------- 320 : EI=YUNG 321 : UNSYG=1.D00/YUNG 322 : U5SNU=1.5D00/(1.D00+XNU) 323 : U5DMU=U5SNU*YUNG 324 : SREF=YUNG*XRF 325 : IPLAST=0 326 : LCGDF=36 327 : LPLUS=6 328 : ITER=1 329 : LAPOIN=0 330 : C 331 : C CAS DES COQUES EN GLOBAL - ON RECUPERE LE ALFAH 332 : C 333 : ALFAH=1.D0 334 : IF(ITYP.EQ.2) ALFAH=CARAC(2)**2 335 : IF(ITYP.EQ.7) ALFAH=CARAC(2)**2 336 : UNALF=0.D0 337 : IF(ALFAH.GE.1.D-12) UNALF=1.D0/ALFAH 338 : C 339 : C CAS DES BARRES ET DES CABLES 340 : C 341 : IF(ITYP.EQ.4) THEN 342 : DIV(1)=1.D0 343 : DIV(2)=1.D0 344 : DIV(3)=1.D0/CARAC(1) 345 : ENDIF 346 : C 347 : C CAS DES POUTRES 348 : C 349 : IF(ITYP.NE.11) GO TO 841 350 : DIV(1)=1.D0/CARAC(4) 351 : DIV(2)=1.D0 352 : DIV(3)=1.D0 353 : DIV(4)=CARAC(10)/CARAC(1) 354 : DIV(5)=CARAC(11)/CARAC(2) 355 : DIV(6)=CARAC(12)/CARAC(3) 356 : IF(DIV(4).EQ.0.D0) DIV(4)=1.D-10/SQRT(CARAC(1)*CARAC(4)) 357 : IF(DIV(5).EQ.0.D0) DIV(5)=1.D-10/SQRT(CARAC(2)*CARAC(4)) 358 : IF(DIV(6).EQ.0.D0) DIV(6)=1.D-10/SQRT(CARAC(3)*CARAC(4)) 359 : GO TO 761 360 : 841 CONTINUE 361 : C 362 : C CAS DES TUYAUX 363 : C 364 : IF(ITYP.NE.12) GO TO 842 365 : EPAIS=CARAC(1) 366 : REXT=CARAC(2) 367 : RMOY=REXT-EPAIS*0.5D0 368 : RACO=CARAC(3) 369 : GAM=1.D0 370 : XK=1.D0 371 : IF(RACO.EQ.0.D0) GO TO 765 372 : XLAM=RMOY*RMOY/EPAIS/RACO 373 : XK=1.65D0*XLAM 374 : IF(XK.LT.1.D0) XK=1.D0 375 : GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0 376 : IF(GAM.LT.1.D0) GAM=1.D0 377 : 765 CONTINUE 378 : C 379 : C NB 23/09/98 380 : C VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY 381 : C CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES 382 : C CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS 383 : C DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE 384 : C DUE A LA PRESSION ) 385 : C POUR L'INSTANT PAS DE CONTRAINTE CIRCONFERENTIELLE 386 : C DUE A LA PRESSION ON N'UTILISE DONC PAS DIV(7) 387 : C 388 : C 389 : DIV(1)=1.D0 390 : DIV(2)=1.D0 391 : DIV(3)=1.D0 392 : DIV(4)=R33 393 : DIV(5)=PI4*GAM 394 : DIV(6)=DIV(5) 395 : DIV(7)=0.D0 396 : IF(IDIM.EQ.2) THEN 397 : PRES1=CARAC(6) 398 : CISA1=CARAC(7) 399 : IXCAR1=12 400 : IDEB1=8 401 : ELSE IF(IDIM.EQ.3) THEN 402 : PRES1=CARAC(7) 403 : CISA1=CARAC(8) 404 : IXCAR1=13 405 : IDEB1=9 406 : ENDIF 407 : C 408 : JDIV1=2 409 : DO 1515 IBA=IDEB1,IXCAR1 410 : JDIV1=JDIV1+1 411 : VCAR1=CARAC(IBA) 412 : IF (VCAR1.NE.-1.D0) DIV(JDIV1)=CARAC(IBA) 413 : 1515 CONTINUE 414 : C 415 : C NB 23/09/98 416 : C TRANSFERT DE CFFX DANS DIV(1) ET REMISE A 417 : C 1.D0 DE DIV(3) 418 : C 419 : DIV(1) = DIV(3) 420 : DIV(3)=1.D0 421 : C 422 : VX=CARAC(4) 423 : VY=CARAC(5) 424 : VZ=CARAC(6) 424 : CALL TUYCAR(CARAC,CISA1,VX,VY,VZ,KERRE,2) 425 : IF(KERRE.EQ.0) GO TO 843 426 : KERRE=7 427 : RETURN 428 : 843 CONTINUE 429 : C 430 : C NB 23/09/98 431 : C DIVISION DE DIV(5) ET DIV(6) PAR XK 432 : C CAR TUYCAR SORT LES INERTIES MODIFIEES 433 : C POUR LE CALCUL DES DEFORMATIONS PAR EPSIG 434 : C 435 : DIV(5)=DIV(5)/XK 436 : DIV(6)=DIV(6)/XK 437 : C 438 : DIV(1)=DIV(1)/CARAC(4) 439 : DIV(4)=DIV(4)*RMOY/CARAC(1) 440 : DIV(5)=DIV(5)*RMOY/CARAC(2) 441 : DIV(6)=DIV(6)*RMOY/CARAC(3) 442 : 761 CONTINUE 443 : E(1)=YUNG 444 : E(2)=0.D0 445 : E(3)=0.D0 446 : E(4)=YUNG*1.5D0/(1.D0+XNU) 447 : E(5)=YUNG 448 : E(6)=YUNG 449 : 842 CONTINUE 450 : C 451 : IF(ICINE.EQ.0.OR.JFLUAG.EQ.1) GO TO 204 452 : C 453 : C ON EST EN CINEMATIQUE ( PLASTIQUE OU FLUAGE ) 454 : C DANS CE CAS ON FLUE AVEC SIGMA-ALPHA QUE L'ON CALCULE 455 : C 456 : DO 206 IBA=1,IBOU 457 : 206 SIGMA(IBA)=SIGMA(IBA)-SPHER(IBA) 458 : 204 CONTINUE 459 : C 460 : IF(JNTRIN.EQ.0) GO TO 830 461 : TIMEXF=TIMEXI 462 : GO TO 831 463 : 830 TIMEXI=TEMPS-HPAS 464 : TIMEXF=TEMPS 465 : 831 CONTINUE 466 : IF(ITYP.NE.11.AND.ITYP.NE.12.AND.ITYP.NE.4) GO TO 844 467 : DO 845 IBA=1,IBOU 468 : SIGMA(IBA)=SIGMA(IBA)*DIV(IBA) 469 : IF(ICINE.EQ.0) GO TO 845 470 : IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 845 471 : SPHER(IBA)=SPHER(IBA)*DIV(IBA) 472 : 845 DSIGMA(IBA)=DSIGMA(IBA)*DIV(IBA) 473 : 844 CONTINUE 474 : DO 886 IBA=1,IBOU 475 : 886 STOT(IBA)=SIGMA(IBA)+DSIGMA(IBA) 476 : C---------------------------------------------------------------------- 477 : C CALCUL DE LA LIMITE ELASTIQUE 478 : C---------------------------------------------------------------------- 479 : IF(LFLUAG.EQ.1) GO TO 261 480 : IF(IMAPLA.NE.4) GO TO 262 481 : BPSTAR=EPSM1 482 : ICOD=1 482 : CALL CHALIM(BPSTAR,SELAS,XMAT,TET,ICOD, 483 : . BID,BID,BID,BID,BID1,BID2,BI3,BI4,BI5,BI6,IBID,IBID,NUMCHA) 484 : GO TO 261 485 : 262 IF(IMAPLA.NE.5) GO TO 263 486 : * REMPLACEMENT XMAT(7) PAR XMAT(12) AM 8/3/90 487 : * TEST SELON EPSM1 AM 28/1/91 488 : IF(EPSM1.EQ.0.D0) THEN 489 : SELAS = XMAT(12) 490 : ELSE 491 : SELAS = XMAT(7) + EPSM1 * XMAT(13) 492 : * 493 : * AM 24/5/93 TEST SUR SELAS 494 : * 495 : IF( SELAS.LT.0.D0) THEN 496 : SELAS = 0.D0 497 : ENDIF 498 : * 499 : ENDIF 500 : GO TO 261 501 : 263 CONTINUE 502 : EPSTAR=EPSM1 503 : IF(ICINE.EQ.1) EPSTAR=0.D0 503 : CALL TRACTI(SELAS,EPSTAR,SIG,EPS,NCOURB,2,IBI) 504 : IF(IBI.EQ.1) THEN 505 : KERRE=75 506 : GOTO 1000 507 : ENDIF 508 : * 509 : 261 CONTINUE 510 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 511 : C A VOIR CE QU'IL Y A DANS ANORM 512 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 513 : IF(IMAPLA.EQ.7) COVNMS(1)=ANORM(2*JC-1) 514 : IF(IMAPLA.EQ.7.AND.IT.EQ.1) ANORM(2*JC)=1.D-20 515 : * 516 : * SI MATERIAU DRUCKER PRAGER ON CHERCHE LE CRITERE 517 : * AVEC LEQUEL ON DOIT FAIRE LA PROJECTION ET LE CRITERE 518 : IXMAT=5 519 : IF(IMAPLA.EQ.5.AND.EPSM1.EQ.0.D0) IXMAT=10 519 : CALL CKRIT(IMAPLA,STOT,ITYP,XMAT(IXMAT),ALFAH,COVNMS,XINV,SSTAR) 520 : SJ1=XINV(1) 521 : SJ2=XINV(2) 522 : IF(IMAPLA.EQ.0) GO TO 3 523 : IF(JFLUAG.NE.0) GO TO 4 524 : C--------------------------------------------------------------------- 525 : C A T'ON DEPASSE LA LIMITE ELASTIQUE 526 : C--------------------------------------------------------------------- 527 : PETI=1.1D00*TEST*SSTAR 527 : CALL EPSPRE(SSTAR,SELAS,PETI,ITRY) 528 : IF(ITRY.EQ.0.AND.SSTAR.GT.SELAS) GO TO 4 529 : C---------------------------------------------------------------------- 530 : C ON N'A PAS PLASTIFIE 531 : C---------------------------------------------------------------------- 532 : 3 CONTINUE 533 : IF(ITYP.EQ.11.OR.ITYP.EQ.12.OR.ITYP.EQ.4) THEN 534 : DO 447 IBA=1,IBOU 535 : IF(ICINE.NE.0) SPHER(IBA)=SPHER(IBA)/DIV(IBA) 536 : 447 STOT(IBA)=STOT(IBA)/DIV(IBA) 537 : ENDIF 538 : DO 32 IBA=1,IBOU 539 : SIGFIN(IBA)=STOT(IBA) 540 : DEFPLA(IBA)=0.D0 541 : 32 DSIGMA(IBA)=0.D0 542 : STARF=SSTAR 543 : EPST=EPSM1 544 : GO TO 31 545 : C---------------------------------------------------------------------- 546 : C ON A PLASTIFIE 547 : C---------------------------------------------------------------------- 548 : 4 CONTINUE 549 : IPLAST=1 550 : PENTE=0.D0 551 : SLOPE=0.D0 552 : DO 360 IBA=1,IBOU 553 : 360 W1(IBA)=SIGMA(IBA) 553 : CALL CKRIT(IMAPLA,W1,ITYP,XMAT(5),ALFAH,COVNMS,XINV,S0) 554 : EPSTAR=EPSM1 555 : C 556 : C EN FLUAGE SI ON LA VITESSE DE FLUAGE NE DEPEND QUE 557 : C DU EPSILON EQUIVALENT DE FLUAGE CUMULE ON VA LE LIRE DANS EPSFLU 558 : C 559 : IF(JFLUAG.NE.0.AND.IFLUPL.EQ.1) EPSTAR=EPSFLU 560 : EPSIN=EPSTAR 561 : SEL=0.D0 562 : SPLA=1.D0 563 : IF(JFLUAG.NE.0) GO TO 70 563 : CALL SIGELP(SIGMA,DSIGMA,SIGEL,DSIGP,STOT,PETI, 564 : . ITYP,SEL,SPLA,IBOU,S0,SELAS,XMAT(5),COVNMS,ALFAH, 565 : . IMAPLA,SSTAR) 565 : CALL SHIFTD(SIGEL,DALPHA,IBOU) 566 : GO TO 2333 567 : C 568 : 70 CONTINUE 569 : C 570 : DO 7 IBA=1,IBOU 571 : SIGEL(IBA)=SIGMA(IBA)+SEL*DSIGMA(IBA) 572 : DALPHA(IBA)=SIGEL(IBA) 573 : 7 DSIGP(IBA)=SPLA*DSIGMA(IBA) 574 : 2333 CONTINUE 575 : DTIMEX=SPLA*HPAS 576 : IF(JNTRIN.EQ.1.OR.JNTRIN.EQ.3) TIMEXF=TIMEXI+DTIMEX 577 : C 578 : C CALCUL DES PENTES 579 : C 580 : IF(ABS(SPLA).LT.0.95D00) IELPLA=0 581 : IF(ICYCL.NE.1) GO TO 71 582 : C 583 : C CAS DES MODELES DE CYCLAGE 584 : C 584 : CALL NORMAL(A1,A2,A3,SIGEL,W1,ALFAH,SELAS,IBOU,ITYP) 585 : CZZZZZZZZZZZZZZZZZZZZZZ 586 : C ON RECUPERE LA NORMALE DE LA DERNIERE SORTIE 587 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 588 : DO 721 IBA=1,IBOU 589 : 721 W2(IBA)=ANORM(IBA) 590 : C 591 : C CALCUL DU PRODUIT SCALAIRE DE LA NORMALE AU POINT OU ON SORT 592 : C AVEC LA DERNIERE NORMALE OU ON EST SORTI 593 : C 594 : X=SDOT(IBOU,W1,1,W2,1) 595 : C ON STOCKE LA NORMALE 596 : DO 720 IBA=1,IBOU 597 : 720 ANORM(IBA)=W1(IBA) 598 : CZZZZZZZZZZZZZZZZZZZZZZZ 599 : C IL FAUDRA LA STOCKER DANS VARINF AU LIEU DE ANORM 600 : CZZZZZZZZZZZZZZZZZZZZZZZZZ 601 : C 602 : C CALCUL DU EPSI AVEC QUOI CALCULER LA PENTE 603 : C 604 : EPSEN=0.5D00*(X+1.D00)*EPENT 605 : EPSIN=EPSEN 606 : 71 CONTINUE 607 : IF(JFLUAG.EQ.0) GO TO 40 608 : IF(IMAPLA.EQ.4) GO TO 5 609 : C 610 : C INITIALISATIONS POUR LE FLUAGE 611 : C QUEL EST LE EPSILON CUMULE DE FLUAGE 612 : C 613 : SLOPE=0.D0 614 : PENTE=0.D0 615 : IF(ICINE.EQ.0) GO TO 5 616 : IF(JFLUAG.EQ.2) GO TO 40 617 : C 618 : C CAS CINE + FLUAGE : CALCUL DE LA PENTE A LA COURBE DE TRACTION 619 : C 620 : IF(ICINE.EQ.2) EPSIN=EPS(NCOURB) 620 : CALL TRACTI(PENTE,EPSIN,SIG,EPS,NCOURB,1,IBI) 621 : IF(IBI.EQ.1) THEN 622 : KERRE=75 623 : GOTO 1000 624 : ENDIF 625 : * 626 : GO TO 5 627 : 40 CONTINUE 628 : IF(IMAPLA.EQ.5.OR.IMAPLA.EQ.4) GO TO 5 629 : C 630 : C CALCUL DE LA PENTE DE LA COURBE DE TRACTION AU POINT X-EPSTAR 631 : C 632 : SLOPE=0.D0 632 : CALL TRACTI(PENTE,EPSIN,SIG,EPS,NCOURB,1,IBI) 633 : IF(IBI.EQ.1) THEN 634 : KERRE=75 635 : GOTO 1000 636 : ENDIF 637 : * 638 : IF(ICINE.EQ.0) GO TO 5 639 : 6 SLOPE=PENTE 640 : PENTE=0. 641 : PANTIN=SLOPE 642 : IF(ICINE.EQ.1) GO TO 5 643 : EPSIN=EPS(NCOURB) 643 : CALL TRACTI(PANTIN,EPSIN,SIG,EPS,NCOURB,1,IBI) 644 : IF(IBI.EQ.1) THEN 645 : KERRE=75 646 : GOTO 1000 647 : ENDIF 648 : * 649 : PENTE=SLOPE-PANTIN 650 : SLOPE=PANTIN 651 : 5 CONTINUE 652 : IF(IMAPLA.NE.4) GO TO 5621 653 : C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 654 : C MODELE CHABOCHE 655 : C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 656 : iecou=0 657 : inecou=0 658 : IF(JFLUAG.EQ.0) 658 : . CALL CHABOK(YUNG,XNU,IA,EI, 659 : . XMAT,SPHER,JA,IBOU,SI,DEPS,EPST,EPSTAR,WORK,KERRE,SN, 660 : . AUXIL,NUMCHA,iecou,inecou) 661 : IF(JFLUAG.NE.0) 661 : . CALL CHAFLU(YUNG,XNU,IA,EI,SSTAR, 662 : 1 XMAT,SPHER,IBOU,SI,DEPS,EPST,EPSTAR,WORK, 663 : 2 AUXIL,DPSM1,DPSM2,KERRE,NUMCHA,iecou,inecou) 664 : IF(KERRE.NE.0) RETURN 665 : IF(JFLUAG.NE.0.AND.IMAPLA.EQ.4) GO TO 689 666 : IF(IMAPLA.EQ.4) GO TO 570 667 : 5621 CONTINUE 668 : IF(IMAPLA.NE.5) GO TO 9997 669 : C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 670 : C MODELE DRUCKER-PRAGER - PRELIMINAIRES 671 : C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 672 : C ON EST DANS LE CAS DU MATERIAU DRUCKER-PRAGER.ON VA FAIRE UN 673 : C TEST POUR SAVOIR SI L'ON DOIT PROJETER AU SOMMET DU CONE ET 674 : C EVENTUELLEMENT FAIRE CETTE PROJECTION. 675 : C DANS CETTE VERSION,LE TEST CONSISTE A SAVOIR SI L'ETAT DE 676 : C CONTRAINTES CALCULE ELASTIQUEMENT SE TROUVE D'UN COTE OU DE 677 : C L'AUTRE D'UN PLAN ORTHOGONAL A L'AXE ET PASSANT PAR LE SOMMET 678 : C DU CONE,PUIS A SAVOIR SI L'ON EST A L'INTERIEUR OU A 679 : C L'EXTERIEUR DU CONE DES NORMALES AU CRITERE DE DRUCKER. 680 : C ON CALCULE LE I1 QUI DELIMITE LES DEUX REGIONS ET ON LE 681 : C COMPARE AVEC LE PREMIER INVARIANT DU TENSEUR CALCULE ELASTIQUEMENT 682 : C 683 : C 684 : C SNN=XMAT(7)+XMAT(13)*EPSTAR 685 : * 686 : * AM 24/5/93 TEST SUR SNN 687 : * 688 : * IF( SNN*XMAT(7).LT.0.D0) THEN 689 : * SNN=0.D0 690 : * XMAT(13)=0.D0 691 : * ENDIF 692 : * 693 : C 694 : C MILL 17/3/93 695 : C SI XMAT(5)=0. PAS DE TEST PAR RAPPORT AU SOMMET 696 : C 697 : C IF(XMAT(5).EQ.0.D0) GO TO 99970 698 : C 699 : C XI1LIM=SNN/XMAT(5) 700 : C IF(SJ1.LE.XI1LIM) GO TO 99970 701 : C 702 : C ON TESTE ENSUITE PAR RAPPORT AU CONE DES NORMALES 703 : C 704 : C TESTDR=-XMAT(9)*SJ1/(2.D0*XMAT(8))+SJ2+XI1LIM*XMAT(9)/ 705 : C . (2.D0*XMAT(8)*XMAT(5)) 706 : C IF(TESTDR.GT.0.D00)GO TO 99970 707 : C 708 : C ON EST MAINTENANT DANS LE CAS OU L'ON DOIT PROJETER AU SOMMET 709 : C 709 : C CALL SOMDRU(IBOU,SI,DEPS,EPST,EPSTAR,SNN,XMAT(5),YUNG,XNU,KERRE) 710 : C IF(KERRE.NE.0) RETURN 711 : C LAPOIN=1 712 : C GO TO 570 713 : 99970 CONTINUE 713 : CALL SHIFTD(DHOOK,WORK(109),36) 714 : iecou=0 715 : inecou=0 715 : CALL PRJDRU(SSTAR,SELAS,PENTE,IBOU,SI,DEPS,EPST,EPSTAR,ITER, 716 : . SN,WORK(109),WORK,WORK(37),WORK(73),XMAT(5),YUNG, 717 : . XNU,LAPOIN,KERRE,iecou,inecou) 718 : IF(KERRE.NE.0) RETURN 719 : GO TO 570 720 : C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 721 : C MODELE ROUSSELIER 722 : C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 723 : 9997 IF(IMAPLA.EQ.7) THEN 723 : CALL FISSUR 723 : C CALL FISSUR(YUNG,XNU,U5DMU,XMAT(5),A,B,C,ANORM, 724 : C 1 JC,SIG,EPS,SELAS,SSTAR,IBOU,JKI,PENTE,EPSTAR,EPST,ITMAX,COEF, 725 : C 1 IA,S0,SI,DEPS,SN,IMPRI) 726 : GO TO 570 727 : ENDIF 728 : C 729 : IF(IRELAX.EQ.0) GO TO 42 730 : DO 43 IBA=1,IBOU 731 : C 732 : C MODIF DU 18/3/86 ON MET SIPLAD A 0. ( AVANT ON AVAIT DEFP ) 733 : C 734 : SIPLAD(IBA)=0.D00 735 : 43 DSIGP0(IBA)=DSIGZE(IBA) 736 : 42 CONTINUE 737 : IF(JGRDEF.LE.1) GO TO 420 738 : C 739 : C INTEGRATION EN GRANDES DEFORMATIONS D N'EST PLUS ISOTROPE 740 : C ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 741 : C A VOIR||||||||||||||||||||||||| 741 : CALL SHIFTD(DHOOK,WORK,36) 742 : RAI=DETFNO(1) 742 : CALL T6CDCT 742 : C CALL T6CDCT(CGDFNO((IA-1)*LCGDF+1),WORK,4,W1,RAI) 742 : CALL PRJGDF 742 : C CALL PRJGDF(SSTAR,SELAS,PENTE,IBOU,SI,DEPS,EPST,EPSTAR, 743 : C 1 ITER,SN,TET,WORK,WORK(37),WORK(73),PANTIN,TIMEXF,SIG,EPS,IA, 744 : C 1 WORK(109)) 744 : CALL SHIFTD(W1,DEFPLA,6) 745 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 746 : GO TO 570 747 : 420 CONTINUE 748 : C---------------------------------------------------------------------- 749 : C ECRITURE SOUS FORME DIAGONALE 750 : C DIAGONALISATION DE SIGEL ET DSIGP 751 : C---------------------------------------------------------------------- 752 : NK=1 752 : CALL XYZDIA(DSIGP,SIGEL,W1,W2,A,B,C,D,ITYP,VECPRO) 753 : IF(IRELAX.NE.0) 753 : 1 CALL XYZDIA(SIPLAD,DSIGP0,W1,W2,A,B,C,D,ITYP,VECPRO) 754 : C 755 : GO TO (60,61,61,63,64,65,66,66,68,69,78,79,80),ITYP 756 : C 757 : 80 CONTINUE 758 : C CONTRAINTES PLANES AVEC TOUS LES CISAILLEMENTS 759 : C 760 : RAI=YUNG/(1.D0-XNU*XNU) 761 : E(1)=RAI*(1.D0+XNU)*0.5D0 762 : E(2)=RAI*(1.D0-XNU)*1.5D0 763 : E(3)=0.D0 764 : E(4)=E(2) 765 : E(5)=E(2) 766 : E(6)=E(2) 767 : JKI=34 768 : GO TO 615 769 : C 770 : 79 CONTINUE 771 : C TUYAUX 772 : 78 CONTINUE 773 : C POUTRES 774 : C LE REMPLISSAGE DE E EST FAIT EN AMONT 775 : C 776 : JKI=28 777 : GO TO 615 778 : 69 CONTINUE 779 : GO TO 640 780 : 68 CONTINUE 781 : GO TO 640 782 : 66 CONTINUE 783 : C COQUE OU MEMBRANE A NU =0 OU CP 784 : C 785 : RAI=YUNG 786 : DO 6600 IBA=1,6 787 : 6600 E(IBA)=0.D00 788 : E(1)=RAI 789 : IF(ICINE.NE.0) E(1)=E(1)+SLOPE 790 : E(4)=E(1)*ALFAH 791 : W1(1)=DSIGP(1)/(E(1)+PENTE) 792 : IF(ITYP.EQ.7) THEN 793 : IF(ALFAH.NE.0.D0) THEN 794 : W1(4)=DSIGP(4)/(E(4)+PENTE) 795 : ELSE 796 : W1(4)=0.D0 797 : ENDIF 798 : ENDIF 799 : JKI=18 800 : DEPS=VNMISD(W1,ITYP,ALFAH,COVNMS) 801 : GO TO 640 802 : 65 CONTINUE 803 : C CONTRAINTES PLANES 804 : C 805 : RAI=YUNG/(1.D0-XNU*XNU) 806 : E(1)=RAI*(1.D0+XNU)*0.5D0 807 : E(2)=RAI*(1.D0-XNU)*1.5D0 808 : E(3)=0.D0 809 : E(4)=E(2) 810 : E(5)=E(3) 811 : E(6)=E(3) 812 : JKI=24 813 : GO TO 615 814 : 64 CONTINUE 815 : C MATER QUELCONQUE 816 : C 817 : JKI=18 818 : NK=1 819 : DO 6400 IBA=1,6 820 : 6400 E(IBA)=VALPRO(IBA) 821 : IF(ICINE.EQ.0) GO TO 6401 822 : DO 6402 IBA=1,6 823 : 6402 E(IBA)=E(IBA)+SLOPE 824 : 6401 CONTINUE 825 : DO 6406 IBA=1,6 826 : IF(E(IBA)+PENTE.EQ.0.D00) GO TO 6406 827 : W1(IBA)=DSIGP(IBA)/(E(IBA)+PENTE) 828 : 6406 CONTINUE 829 : DEPS=VNMISD(W1,ITYP,ALFAH,CVNMSD) 830 : GO TO 640 831 : C 832 : 61 RAI=YUNG/(1.D0-XNU*XNU) 833 : E(1)=RAI*(1.D0+XNU)*0.5D0 834 : E(2)=RAI*(1.D0-XNU)*1.5D0 835 : E(3)=E(2) 836 : E(4)=E(1)*ALFAH 837 : E(5)=E(2)*ALFAH 838 : E(6)=E(3)*ALFAH 839 : JKI=6 840 : 615 CONTINUE 841 : IF(ICINE.EQ.0) GOTO 610 842 : DO 611 IK=1,6 843 : 611 E(IK)=E(IK)+SLOPE 844 : 610 CONTINUE 845 : IBO=2 846 : IF(ITYP.EQ.3.OR.ITYP.EQ.6) IBO=1 847 : IF(ITYP.NE.11.AND.ITYP.NE.12.AND.ITYP.NE.4) W1(3)=0.D0 848 : DO 614 I=1,IBOU 849 : IF(ITYP.EQ.6.AND.I.EQ.3) GO TO 614 850 : W1(I)=0.D0 851 : IF(PENTE+E(I).EQ.0.) GO TO 614 852 : W1(I)=DSIGP(I)/(E(I)+PENTE) 853 : 614 CONTINUE 854 : DEPS=VNMISD(W1,ITYP,ALFAH,COVNMS) 855 : GO TO 640 856 : C 857 : 63 E(3)=U5DMU/U5SNU 858 : IF(ICINE.NE.0) E(3)=E(3)+SLOPE 859 : NK=3 860 : JKI=12 861 : E(2)=0.D0 862 : E(1)=0.D0 863 : E(4)=0.D0 864 : E(5)=0.D0 865 : E(6)=0.D0 866 : DEPS=DSIGP(3)/(E(3)+PENTE) 867 : GO TO 640 868 : C 869 : 60 CONTINUE 870 : JKI=0 871 : DO 601 I=1,6 872 : 601 E(I)=U5DMU 873 : E(1)=0. 874 : IF(ICINE.EQ.0) GO TO 603 875 : DO 602 I=1,6 876 : 602 E(I)=E(I)+SLOPE 877 : 603 CONTINUE 878 : EMU=PENTE+U5DMU 879 : RAI=YUNG 880 : IF(IMAPLA.EQ.5) EMU=U5DMU+3*XMAT(5)*XMAT(5)*RAI/(1.D0-2.D0*XNU) 881 : DEPS=(SSTAR-SELAS)/EMU 882 : C 883 : 640 CONTINUE 884 : C 885 : IF(JFLUAG.NE.0) GO TO 41 886 : C----------------------------------------------------------------------- 887 : C PLASTICITE - PROJECTION SUR LA SURFACE DE CHARGE 888 : C----------------------------------------------------------------------- 889 : iecou=0 890 : inecou=0 890 : CALL PROJVM(SIG,EPS,EPST,EPSTAR,DEPS,PENTE,SN,PANTIN, 891 : 1 SELAS,ITER,SO,SSTAR,SI,NK,IBOU,COEF,JKI,KERRE,iecou,inecou) 892 : C 893 : GO TO 57 894 : C----------------------------------------------------------------------- 895 : C FLUAGE 896 : C----------------------------------------------------------------------- 897 : 41 CONTINUE 898 : iecou=0 899 : inecou=0 899 : CALL FLUAGE(ITER,EPSTAR,S0,EPST,SSTAR,SI,DPSM1,DPSM2, 900 : . IBOU,DEPS,ICONV,TIMEXI,TIMEXF,YUNG,KERRE,iecou,inecou) 901 : IF(KERRE.EQ.0) GO TO 8693 902 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 903 : C TESTER KERRE EN SORTIE DE FLUAGE 904 : C ON RECUPERE AUUSI ICONV EN SORTIE 905 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 906 : 8693 CONTINUE 907 : 689 CONTINUE 908 : C----------------------------------------------------------------------- 909 : C ON STOKE LE EPS DE FLUAGE DANS EPSFLU DANS TOUS LES CAS 910 : C----------------------------------------------------------------------- 911 : EPSFLU=EPST 912 : C ON CALCULE LE EPSILON INELASTIQUE CUMULE 913 : C 914 : EPST=EPSM1 915 : IF(LFLUAG.EQ.1) GO TO 414 916 : C ON ECROUIT LE RAYON DE LA SURFACE DE CHARGE 917 : C 918 : EPST=DEPS+EPSM1 919 : 414 CONTINUE 920 : IF(IMAPLA.EQ.4) GO TO 570 921 : IF(ICINE.EQ.0) GO TO 413 922 : IF(LFLUAG.EQ.1) GO TO 57 923 : C CAS CINEMATIQUE 924 : C 925 : SLIM=SELAS 926 : GO TO 57 927 : 413 CONTINUE 928 : C CAS ISOTROPE 929 : C 930 : IF(LFLUAG.EQ.1) GO TO 57 931 : C ON CHERCHE LE NOUVEAU RAYON DE LA SPHERE 932 : C 932 : CALL TRACTI(SF,EPST,SIG,EPS,NCOURB,2,IBI) 933 : IF(IBI.EQ.1) THEN 934 : KERRE=75 935 : GOTO 1000 936 : ENDIF 937 : * 938 : SLIM=SF 939 : C 940 : 57 CONTINUE 941 : C 942 : C---------------------------------------------------------------------- 943 : C RETOUR AUX AXES X Y Z 944 : C---------------------------------------------------------------------- 944 : CALL DIAXYZ(ITYP,SIGT,SIGEL,VECPRO,IBO,A,B,C,B1,B2) 945 : IF(JFLUAG.EQ.0) GO TO 10 946 : IF((IT.EQ.1.AND.IRELAX.EQ.0).OR.(ICONV.NE.0.AND.IRELAX.NE.0)) 946 : . CALL DIAXYZ(ITYP,DSIGP,STOT,VECPRO,IBO,A,B,C,B1,B2) 947 : 10 CONTINUE 948 : C----------------------------------------------------------------------- 949 : C TRAITEMENT FINAL 950 : C----------------------------------------------------------------------- 951 : 570 CONTINUE 952 : EPSM1F=EPST 953 : IF(ICYCL.EQ.1) EPENTF=EPSEN+DEPS 954 : IF(IMAPLA.NE.7) GO TO 9100 955 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 956 : C VOIR SI ON A BESOIN DE SIGT 957 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 958 : DO 9101 IBA=1,IBOU 959 : 9101 SIGT(IBA)=SIGT(IBA)-W1(IBA) 960 : 9100 CONTINUE 961 : IF(ICINE.EQ.0) GO TO 913 962 : IF(LFLUAG.EQ.1) GO TO 913 963 : IF(JFLUAG.EQ.1) GO TO 94 964 : IF(IMAPLA.EQ.4) GO TO 90 965 : C---------------------------------------------------------------------- 966 : C CAS CINEMATIQUE - CALCUL DE DALPHA 967 : C---------------------------------------------------------------------- 968 : Z=PANTIN*DEPS/SELAS 969 : IF(Z.LT.0.01D00) GO TO 910 970 : EZZ=1.D0-EXP(-Z) 971 : Z=1.D0-EZZ/Z 972 : EZZ=EZZ/(1.D0-Z) 973 : Z=Z/(1.D0-Z) 974 : DO 91 IBA=1,IBOU 975 : DALPHA(IBA)=DALPHA(IBA)*EZZ+Z*(SIGEL(IBA)-DALPHA(IBA)) 976 : 91 CONTINUE 977 : GO TO 90 978 : 910 DO 911 IBA=1,IBOU 979 : DALPHA(IBA)=Z*0.5D0*(DALPHA(IBA)+SIGEL(IBA)) 980 : 911 CONTINUE 981 : GO TO 90 982 : 94 CONTINUE 983 : IF(IMAPLA.EQ.4) GO TO 913 983 : CALL MOVCEN(PENTE,DEPS,SELAS,JA,IBOU,DALPHA,SIGMA,SPHER,SIGEL) 984 : 90 CONTINUE 985 : 913 CONTINUE 986 : C---------------------------------------------------------------------- 987 : C CAS CINEMATIQUE COORDONNEES DU NOUVEAU CENTRE DE LA SPHERE 988 : C---------------------------------------------------------------------- 989 : IF(ICINE.EQ.0) GO TO 29 990 : C 991 : C MODELE CHABOC MISE A JOUR DE SPHER DANS CHABOC 992 : C SPHER CONTIENT LA SOMME DES DEPLACEMENTS DES SPHERES 993 : C 994 : IF(IMAPLA.EQ.4) GO TO 29 995 : IF(LFLUAG.EQ.1.AND.JFLUAG.NE.0) GO TO 29 996 : DO 34 IBA=1,IBOU 997 : 34 SPHER(IBA)=SPHER(IBA)+DALPHA(IBA) 998 : 29 CONTINUE 999 : C----------------------------------------------------------------------- 1000 : C CALCUL DU SIGMA FINAL ET DE LA NOUVELLE LIMITE ELASTIQUE 1001 : C----------------------------------------------------------------------- 1002 : IF(ITYP.NE.11.AND.ITYP.NE.12.AND.ITYP.NE.4) GO TO 846 1003 : DO 847 IBA=1,IBOU 1004 : STOT(IBA)=STOT(IBA)/DIV(IBA) 1005 : IF(ICINE.EQ.0) GO TO 847 1006 : IF(LFLUAG.EQ.1.AND.JFLUAG.NE.0) GO TO 847 1007 : SPHER(IBA)=SPHER(IBA)/DIV(IBA) 1008 : DALPHA(IBA)=DALPHA(IBA)/DIV(IBA) 1009 : 847 SIGEL(IBA)=SIGEL(IBA)/DIV(IBA) 1010 : 846 DO 291 IBA=1,IBOU 1011 : 291 SIGFIN(IBA)=SIGEL(IBA) 1012 : STARF=SI 1013 : IF(JFLUAG.EQ.0) SLIMF=SN 1014 : IF(JNTRIN.NE.0) EPENTF=TIMEXF 1015 : C 1016 : IF(DEPS.LT.0.D00) KERRE=1 1017 : C CALCUL DU NOUVEAU SIGMAP 1018 : DO 24 IBA=1,IBOU 1019 : 24 DSIGMA(IBA)=STOT(IBA)-SIGEL(IBA) 1020 : IF(ICINE.EQ.0) GO TO 240 1021 : IF(JFLUAG.EQ.1) GO TO 240 1022 : IF(LFLUAG.EQ.1) GO TO 240 1023 : DO 241 IBA=1,IBOU 1024 : 241 DSIGMA(IBA)=DSIGMA(IBA)-DALPHA(IBA) 1025 : 240 CONTINUE 1026 : * 1027 : IF(ITYP.EQ.6.AND.IMAPLA.EQ.5.AND.LAPOIN.EQ.0) THEN 1028 : DO 322 IBA=1,IBOU 1029 : 322 DEFPLA(IBA)=EPSPLA(IBA) 1030 : EPST=EPSM1 + VONEPS(DEFPLA,ITYP,ALFAH,COVNMS) 1031 : GO TO 31 1032 : ENDIF 1033 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 1034 : C ATTENTION LE EPSIG NE MARCHE QUE POUR CERTAINS CAS 1035 : CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ 1035 : CALL EPSIG(DSIGMA,DEFPLA,IFOURB,YUNG,XNU,ITYP,ORMAT,CARAC) 1036 : IF(ITYP.EQ.6.AND.IMAPLA.NE.5) DEFPLA(3)=-DEFPLA(1)-DEFPLA(2) 1037 : 31 CONTINUE 1038 : C----------------------------------------------------------------------- 1039 : C REMPLISSAGE 1040 : C----------------------------------------------------------------------- 1041 : VARINF(1)=EPST 1042 : CZZZZZZZZZZZ 1043 : C PROVISOIRE 1044 : CZZZZZZZZZZZ 1045 : IF(JFLUAG.EQ.1) VARINF(1)=EPSFLU 1046 : IF(ICINE.EQ.0) GO TO 280 1047 : C ON CALCULE LA VRAIE CONTRAINTE EN CINEMATIQUE 1048 : DO 281 IBA=1,IBOU 1049 : IF(JFLUAG.EQ.1) GO TO 284 1050 : SIGFIN(IBA)=SIGFIN(IBA)+SPHER(IBA) 1051 : 284 IF(LFLUAG.EQ.1) GO TO 281 1052 : IF(ICENT2.NE.0) SPHER(IBA)=SPHER(IBA)-AUXIL(IBA) 1053 : 281 CONTINUE 1054 : 280 CONTINUE 1055 : * 1056 : * MISE A 0. DES COMPOSANTES NON CALCULEES SI ITYP=8 1057 : * 1058 : IF(ITYP.EQ.8.AND.IBOU.LT.NSTRS) THEN 1059 : DO 285 IBA=2,NSTRS 1060 : DEFPLA(IBA)=0.D0 1061 : SIGFIN(IBA)=0.D0 1062 : IF(ICENT2.NE.0) SPHER(IBA)=0.D0 1063 : 285 CONTINUE 1064 : ENDIF 1065 : * 1066 : MCOD=2 1067 : iecou=0 1068 : inecou=0 1068 : CALL VISAVI(SIG0,DSIGT,VARIN0,SIGMA,DSIGMA,SPHER,AUXIL, 1069 : . SIGF,DEFP,VARINF,SIGFIN,DEFPLA, 1070 : . DSIGZE,ICENT2,MCOD,IBOU,MFR,NSTRS,CARAC,CMATE, 1071 : . iecou,inecou) 1072 : C 1073 : C RETRAITEMENT POUR LES COQ2 ET MASSIFS EN MATERIAU 1074 : C UNIDIRECTIONNEL 1075 : C 1076 : 1077 : IF (CMATE.EQ.'UNIDIREC'.AND.INPLAS.NE.0) THEN 1078 : IF(MELE.EQ.44.OR.(MFR.EQ.1.AND.IFOURB.LE.0)) THEN 1079 : DO 1997 I=1,NSTRS 1080 : TABID(I)=SIGF(I) 1081 : TABID2(I)=DEFP(I) 1082 : 1997 CONTINUE 1082 : CALL CHREP2(TABID,SIGF,-ANG,NSTRS,MFR,1,KERRE) 1082 : CALL CHREP2(TABID2,DEFP,-ANG,NSTRS,MFR,2,KERRE) 1083 : IF(KERRE.NE.0) RETURN 1084 : ELSEIF(MFR.EQ.1.AND.IFOURB.EQ.2) THEN 1085 : DO 997 I=1,NSTRS 1086 : TABID(I)=SIGF(I) 1087 : TABID2(I)=DEFP(I) 1088 : 997 CONTINUE 1088 : CALL CHREP3(TABID,SIGF,XMAT,TXR,NSTRS,1,2,KERRE) 1088 : CALL CHREP3(TABID2,DEFP,XMAT,TXR,NSTRS,2,2,KERRE) 1089 : ENDIF 1090 : ENDIF 1091 : * 1092 : 1000 RETURN 1093 : END 1094 : 1095 : 1096 : 1097 : 1098 : 1099 : 1100 : 1101 : 1102 : 1103 : 1104 : 1105 :
© Cast3M 2003 - All rights reserved.
Disclaimer