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