1 : C CBETOC SOURCE PV 11/03/07 21:15:16 6885 2 : C BETOCY SOURCE AM 95/12/27 21:15:06 1962 3 : SUBROUTINE CBETOC(wrk52,wrk53,wrk54,WRK2,NCURVT,NCURVC) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : C 7 : C MODELE DE MACONNERIE ENDOMMAGEABLE EN CYCLIQUE 8 : C 9 : C======================================================================= 10 : C CETTE ROUTINE EST APPELE DANS ECOUL2 11 : C 12 : C ENTREES: 13 : C ------- 14 : C SIG0 = CONTRAINTES AU DEBUT DU PAS D'INTEGRATION 15 : C DSIGT = INCREMENT DE CONT. CALCULE ELASTIQUEMENT A PARTIR DE 16 : C L'INCREMENT DES DEFORMATIONS TOTALES 17 : C VAR0 = VARIABLES INTERNES AU DEBUT DU PAS D'INTEGRATION 18 : C 19 : C XMAT = CARACTERISTIQUES MECANIQUES DU MATERIAU 20 : C 21 : C SORTIES: 22 : C ------- 23 : C SIGF = CONTR. A LA FIN DU PAS D'INTEGRATION 24 : C VARF = VARIABLES INTERNES A LA FIN DU PAS D'INTEGRATION 25 : C DEFP = INCREMENT DES DEFORM. PLASTIQUES A LA FIN DU PAS 26 : C D'INTEGRATION 27 : C KERRE = INDICE QUI REGIT LES ERREURS 28 : C 29 : C========================================================================= 30 : C VARIABLES NECESSAIRES 31 : C========================================================================= 32 : -INC CCOPTIO 33 : -INC DECHE 34 : C 35 : C Segment pour le Broyden 36 : C 37 : SEGMENT QUASIN 38 : REAL*8 XH0(MN,MN) 39 : REAL*8 WUP(MN,ITM),YUP(MN,ITM) 40 : INTEGER IT 41 : REAL*8 R(MN) 42 : REAL*8 D(MN),DES(MN) 43 : ENDSEGMENT 44 : C Segment des courbes d'ecrouissage 45 : SEGMENT WRK2 46 : REAL*8 TRAC(LTRAC) 47 : ENDSEGMENT 48 : 49 : DIMENSION SIGT(4),SIGI(4), DSIGI(4), DSIGIDI(4) 50 : C Matrice de compliance (C-1) 51 : DIMENSION CINV(3) 52 : C Variables d'ecrouissage isotrope 53 : DIMENSION XKISO(2) 54 : C Travaux plastiques cycliques et Deformations plastiques equivalentes 55 : C associes au mecanisme de compression de la grande surf. 56 : REAL*8 WORK 57 : DIMENSION EPSI(2),EPSI0(2),EPSII(2) 58 : C Contraintes principales et variables d'ecrouissage cinematique 59 : DIMENSION SIGTP(2), SIGHP(2),SIGHP0(2) 60 : C Cos et Sin de l'angle definissant la premiere direction principale 61 : REAL*8 CPHI, CPHI0, CPHI00, SPHI, SPHI0, SPHI00 62 : C Indicateur du contact 63 : DIMENSION KONTAC(4),KONTA0(4) 64 : C Vecteurs contrainte transitoire 65 : DIMENSION SITPRO(4) 66 : C Jacobien initial 67 : DIMENSION XJ00(3,3) 68 : C Variable phi apparaissant au denominateur (calcul de la normale et de A) 69 : REAL*8 PHI 70 : C Matrices contenant A-1 71 : C AINV --> Inverse de A pour la grande surface 72 : C [ A B 0] A=AINV(1) 73 : C AINVGRANDESURFACE = [-B A 0] B=AINV(2) 74 : C [ 0 0 C] C=AINV(3) 75 : DIMENSION AINV(3) 76 : C Vecteurs normaux aux surface 77 : C XNOR1 --> 1eme mecanisme 78 : C XNOR2 --> 2eme mecanisme 79 : DIMENSION XNOR1(4), XNOR2(4) 80 : C 81 : C Multiplicateurs plastiques 2 mecanismes + 2 surfaces dans GAMBDA 82 : C Valeurs des criteres dans FFF 83 : C Valeurs des limites dans RESIST 84 : C Ordre pour les 3 tableaux: 85 : C 1 --> Traction petite surface direction 1 86 : C 2 --> Traction petite surface direction 2 87 : C 3 --> Compression petite surface direction 1 88 : C 4 --> Compression petite surface direction 2 89 : C 5 --> Traction grande surface 90 : C 6 --> Compression grande surface 91 : DIMENSION GAMBDA(6), FFF(6), RESIST(6) 92 : C Valeur necessaire pour le calcul des residus de la grande surface 93 : DIMENSION XKISO0(2),XKISOI(2) 94 : C 95 : C Separation de l'increment en deux ou trois parties dans le cas du contact 96 : C 97 : REAL*8 SPLITT 98 : REAL*8 XFFFS 99 : C 100 : C Pour differencier les differents cas 101 : C ICAS --> NUMERO DU MULTIPLICATEUR PLASTIQUE A METTRE A JOUR 102 : C IHARD --> NUMERO DE LA VARIABLE D'ECROUISSAGE CINEMATIQUE 103 : C ISGNTC --> Signe indiquant si on est en traction ou compression 104 : C ISGN2 --> Signe indiquant si on prend la plus grande ou la plus 105 : C petite contrainte principale 106 : C NCORNER --> Revient-on sur la pointe ? 107 : INTEGER ICAS, IHARD, ISGNTC, ISGN2 108 : INTEGER ICASB, IHARDB, ISGNTCB, ISGN2B 109 : INTEGER NCORNER 110 : C 111 : C Variable intermediaire valant la resistance de la grande surface 112 : C 113 : DIMENSION FG(2) 114 : C 115 : C Critere de convergence 116 : C 117 : DIMENSION EPSIL(6) 118 : C======================================================================== 119 : C Parametres utiles 120 : C======================================================================== 121 : PARAMETER (XZER=0.D0,UN=1.D0,DEUX=2.D0,UNDEMI=.5D0) 122 : PARAMETER (UNRADE=0.707106781D0) 123 : PARAMETER (EPSILO=1.D-8,EPSILO2=-1.D-10) 124 : C======================================================================== 125 : C 126 : C CALCUL DE DSIGT 127 : C 128 : C calcul de la matrice elastique 129 : C 130 : CMATE = 'ISOTROPE' 131 : KCAS=1 131 : CALL DOHMAS(XMAT,CMATE,IFOUR,4,KCAS,DDHOOK,IRTD) 132 : DO IE1=1,4 133 : DSIGT(IE1)=XZER 134 : DO IE2=1,4 135 : DSIGT(IE1)=DSIGT(IE1)+DDHOOK(IE1,IE2)*DEPST(IE2) 136 : ENDDO 137 : ENDDO 138 : DSIGT(3)=XZER 139 : C========================================================================= 140 : C LECTURE DES PARAMETRES DU MATERIAU 141 : C 142 : C========================================================================= 143 : C Module d'Young YOUN, Poisson XNU, Shear GG 144 : C Ecrouissage cinematique XHH1 , 145 : YOUN = XMAT(1) 146 : XNU = XMAT(2) 147 : GGG = YOUN/(2*(UN+XNU)) 148 : XHH1 = XMAT(5) 149 : CPI = YOUN/(UN-XNU) 150 : C 151 : RESIST(1) = XMAT(6) 152 : RESIST(2) = XMAT(6) 153 : RESIST(3) = XMAT(7) 154 : RESIST(4) = XMAT(7) 155 : RESIST(5) = XMAT(8) 156 : RESIST(6) = XMAT(9) 157 : C Deformation plastique equivalente et travail plastique de ref. 158 : C pour la dissipation cyclique 159 : EPS0 = XMAT(10) 160 : WOR0 = XMAT(11) 161 : DEGRAD = EPS0/WOR0 162 : XLCAT = XMAT(14) 163 : XLCAC = XMAT(15) 164 : C 165 : C 166 : C Evolution des variables d'ecrouissage isotrope 167 : C 168 : C Voila les positions des points d'entree des deux courbes dans TRAC 169 : IPT = 1 170 : IPC = IPT+2*NCURVT 171 : C NCURVT : nombre de point de la courbe de traction 172 : C NCURVC : nombre de point de la courbe de compression 173 : C=========================================================== 174 : C Fin lecture des caracteristiques 175 : C On passe aux contraintes et variables d'etat 176 : C=========================================================== 177 : C 178 : C CONTRAINTES ELASTIQUES 179 : C 180 : SIGI(1) = SIG0(1) 181 : SIGI(2) = SIG0(2) 182 : SIGI(4) = SIG0(4) 183 : C DELTA SIGMA TRIAL 184 : DSIGI(1) = DSIGT(1) 185 : DSIGI(2) = DSIGT(2) 186 : DSIGI(4) = DSIGT(4) 187 : C 188 : C ECROUISSAGE CINEMATIQUE 189 : C 190 : SIGHP0(1) = VAR0(1) 191 : SIGHP0(2) = VAR0(2) 192 : C 193 : C ECROUISSAGE ISOTROPE 194 : C 195 : EPSI0(1) = VAR0(3) 196 : EPSI0(2) = VAR0(4) 197 : C 198 : CPHI00 = VAR0(5) + 1.D0 199 : CPHI0 = CPHI00 200 : SPHI00 = VAR0(6) 201 : SPHI0 = SPHI00 202 : C 203 : KONTA0(1) = nint(VAR0( 7)) 204 : KONTA0(2) = nint(VAR0( 8)) 205 : KONTA0(3) = nint(VAR0( 9)) 206 : KONTA0(4) = nint(VAR0(10)) 207 : C 208 : C Variables de contact 209 : C 210 : SPLITT = 0.D0 211 : NCON = 0 212 : IDICHO = 0 213 : NDICHO = 0 214 : NPASS = 0 215 : DSIGIDI(1) = XZER 216 : DSIGIDI(2) = XZER 217 : DSIGIDI(4) = XZER 218 : C=============================================== 219 : C Fin de la lecture des contraintes et des variables d'etat 220 : C================================================ 221 : C 222 : C Premier calcul des residus puis DRIVER 223 : C================================================ 224 : C 225 : C Entree quand on revient des routines, dernier test avant de finir 226 : C 227 : 10 CONTINUE 228 : SIGT(1) = SIGI(1) + DSIGI(1) 229 : SIGT(2) = SIGI(2) + DSIGI(2) 230 : SIGT(4) = SIGI(4) + DSIGI(4) 230 : CALL CONPRI (SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI) 231 : EPSI(1) = EPSI0(1) 232 : EPSI(2) = EPSI0(2) 232 : CALL VALEUR(EPSI(1),TRAC(IPT),NCURVT,XLCAT, 233 : &XKISO(1),DUMM,KERRE) 233 : CALL VALEUR(EPSI(2),TRAC(IPC),NCURVC,XLCAC, 234 : &XKISO(2),DUMM,KERRE) 235 : SIGHP(1) = SIGHP0(1) 236 : SIGHP(2) = SIGHP0(2) 237 : NPASS2 = 0 238 : KONTAC(1) = KONTA0(1) 239 : KONTAC(2) = KONTA0(2) 240 : KONTAC(3) = KONTA0(3) 241 : KONTAC(4) = KONTA0(4) 242 : C 243 : C Calcul des residus initiaux 244 : C 245 : NMEC = 0 246 : FFF(1) = XZER 247 : FFF(2) = XZER 248 : FFF(3) = XZER 249 : FFF(4) = XZER 250 : FFF(5) = XZER 251 : FFF(6) = XZER 252 : FINT1 = XZER 253 : FINT2 = XZER 254 : GAMBDA(1) = XZER 255 : GAMBDA(2) = XZER 256 : GAMBDA(3) = XZER 257 : GAMBDA(4) = XZER 258 : GAMBDA(5) = XZER 259 : GAMBDA(6) = XZER 260 : ICAS = 0 261 : ICASB = 0 262 : C 263 : C Critere de convergence 264 : C 265 : EPSIL(1) = ABS(RESIST(1)*EPSILO) 266 : EPSIL(2) = ABS(RESIST(2)*EPSILO) 267 : EPSIL(3) = ABS(RESIST(3)*EPSILO) 268 : EPSIL(4) = ABS(RESIST(4)*EPSILO) 269 : EPSIL(5) = ABS(RESIST(5)*EPSILO) 270 : EPSIL(6) = ABS(RESIST(6)*EPSILO) 271 : C 272 : C 273 : IF (KONTAC(1).EQ.0) THEN 273 : CALL CRITPE (SIGTP(1), SIGHP0(1), RESIST(1), 1, FFF(1)) 274 : FINT1 = 0. 275 : IF (FFF(1).GE.EPSIL(1)) THEN 276 : NMEC = NMEC + 1 277 : IF (NMEC.EQ.1) THEN 278 : ICAS = 1 279 : ISGNTC = 1 280 : IHARD = 1 281 : ELSE 282 : ICASB = 1 283 : ISGNTCB = 1 284 : IHARDB = 1 285 : ENDIF 286 : ENDIF 287 : ELSE 288 : FG(1) = XKISO(1)*RESIST(5) 288 : CALL CRITPE (SIGTP(1), XZER, FG(1), 1, FINT1) 289 : ENDIF 290 : C 291 : IF (KONTAC(2).EQ.0) THEN 291 : CALL CRITPE (SIGTP(2), SIGHP0(2), RESIST(2), 1, FFF(2)) 292 : FINT2 = 0. 293 : IF (FFF(2).GE.EPSIL(2)) THEN 294 : NMEC = NMEC + 1 295 : IF (NMEC.EQ.1) THEN 296 : ICAS = 2 297 : ISGNTC = 1 298 : IHARD = 2 299 : ELSE 300 : ICASB = 2 301 : ISGNTCB = 1 302 : IHARDB = 2 303 : ENDIF 304 : ENDIF 305 : ELSE 306 : FG(1) = XKISO(1)*RESIST(5) 306 : CALL CRITPE (SIGTP(2), XZER, FG(1), 1, FINT2) 307 : ENDIF 308 : C 309 : IF ((FINT1.GE.EPSIL(5)).OR.(FINT2.GE.EPSIL(5))) THEN 310 : NMEC = NMEC + 1 311 : IF (FINT1.GE.FINT2) THEN 312 : FFF(5) = FINT1 313 : IF (NMEC.EQ.1) THEN 314 : IHARD = 1 315 : ICAS = 5 316 : ISGNTC = 1 317 : ELSE 318 : IHARDB = 1 319 : ICASB = 5 320 : ISGNTCB = 1 321 : ENDIF 322 : ELSE 323 : FFF(5) = FINT2 324 : IF (NMEC.EQ.1) THEN 325 : IHARD = 2 326 : ICAS = 5 327 : ISGNTC = 1 328 : ELSE 329 : IHARDB = 2 330 : ICASB = 5 331 : ISGNTCB = 1 332 : ENDIF 333 : ENDIF 334 : ENDIF 335 : C 336 : IF (KONTAC(3).EQ.0) THEN 336 : CALL CRITPE (SIGTP(1), SIGHP0(1), RESIST(3), -1, FFF(3)) 337 : FINT1 = 0. 338 : IF (FFF(3).GE.EPSIL(3)) THEN 339 : NMEC = NMEC + 1 340 : IF (NMEC.EQ.1) THEN 341 : ICAS = 3 342 : ISGNTC = -1 343 : IHARD = 1 344 : ELSE 345 : ICASB = 3 346 : ISGNTCB = -1 347 : IHARDB = 1 348 : ENDIF 349 : ENDIF 350 : ELSE 351 : FG(1) = XKISO(2)*RESIST(6) 351 : CALL CRITPE (SIGTP(1), XZER, FG(1), -1, FINT1) 352 : ENDIF 353 : C 354 : IF (KONTAC(4).EQ.0) THEN 354 : CALL CRITPE (SIGTP(2), SIGHP0(2), RESIST(4), -1, FFF(4)) 355 : FINT2 = 0. 356 : IF (FFF(4).GE.EPSIL(4)) THEN 357 : NMEC = NMEC + 1 358 : IF (NMEC.EQ.1) THEN 359 : ICAS = 4 360 : ISGNTC = -1 361 : IHARD = 2 362 : ELSE 363 : ICASB = 4 364 : ISGNTCB = -1 365 : IHARDB = 2 366 : ENDIF 367 : ENDIF 368 : ELSE 369 : FG(1) = XKISO(2)*RESIST(6) 369 : CALL CRITPE (SIGTP(2), XZER, FG(1), -1, FINT2) 370 : ENDIF 371 : C 372 : IF ((FINT1.GE.EPSIL(6)).OR.(FINT2.GE.EPSIL(6))) THEN 373 : NMEC = NMEC + 1 374 : IF (FINT1.GE.FINT2) THEN 375 : FFF(6) = FINT1 376 : IF (NMEC.EQ.1) THEN 377 : IHARD = 1 378 : ICAS = 6 379 : ISGNTC = -1 380 : ELSE 381 : IHARDB = 1 382 : ICASB = 6 383 : ISGNTCB = -1 384 : ENDIF 385 : ELSE 386 : FFF(6) = FINT2 387 : IF (NMEC.EQ.1) THEN 388 : IHARD = 2 389 : ICAS = 6 390 : ISGNTC = -1 391 : ELSE 392 : IHARDB = 2 393 : ICASB = 6 394 : ISGNTCB = -1 395 : ENDIF 396 : ENDIF 397 : ENDIF 398 : C 399 : C 400 : C Le tableau FFF contient les residus 401 : C 402 : C================================================ 403 : C DRIVER 404 : C================================================ 405 : IF (NMEC.EQ.0) GOTO 9999 406 : C 407 : IF (NMEC.EQ.1) GOTO 1000 408 : C 409 : IF (NMEC.EQ.2) GOTO 4000 410 : C 411 : GOTO 9999 412 : C================================================== 413 : C CAS 1: 414 : C Un seul mecanisme est active 415 : C================================================== 416 : 1000 CONTINUE 417 : C 417 : CALL CONPRI (SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI) 418 : C 419 : C Mis a jour de isgn2 420 : C 421 : IF (IHARD.EQ.1) THEN 422 : IF (SIGTP(1).GE.SIGTP(2)) THEN 423 : ISGN2 = 1 424 : ELSE 425 : ISGN2 = -1 426 : ENDIF 427 : HARDC = 2 428 : ELSE 429 : IF (IHARD.EQ.2) THEN 430 : IF (SIGTP(2).GE.SIGTP(1)) THEN 431 : ISGN2 = 1 432 : ELSE 433 : ISGN2 = -1 434 : ENDIF 435 : ENDIF 436 : HARDC = 1 437 : ENDIF 438 : C 439 : IF (IHARD.EQ.1) THEN 440 : IHARDC = 2 441 : ELSE 442 : IHARDC = 1 443 : ENDIF 444 : C 445 : NCORNER = 0 446 : C 447 : 1010 CONTINUE 448 : C 449 : C Definition du segment 450 : C 451 : ITM = 30 452 : MN = 1 453 : SEGINI,QUASIN 454 : IT = -1 455 : C 456 : C Calcul de xhh2 et xkiso 457 : C 458 : IF (ICAS.GE.5) THEN 459 : IF (ICAS.EQ.5) THEN 459 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT, 460 : &XKISO(1),XHH2,KERRE) 460 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC, 461 : &XKISO(2),DUMM,KERRE) 462 : ELSE 462 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT, 463 : &XKISO(1),DUMM,KERRE) 463 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC, 464 : &XKISO(2),XHH2,KERRE) 465 : ENDIF 466 : EPSI(1) = EPSI0(1) 467 : XKISO0(1) = XKISO(1) 468 : EPSI(2) = EPSI0(2) 469 : XKISO0(2) = XKISO(2) 470 : XHH2I = XHH2 471 : EPSII(1) = EPSI0(1) 472 : XKISOI(1) = XKISO(1) 473 : EPSII(2) = EPSI0(2) 474 : XKISOI(2) = XKISO(2) 475 : ENDIF 476 : C 477 : DO 1011,IE1=1,6 478 : FFF(IE1) = XZER 479 : 1011 CONTINUE 480 : C 481 : IF (ICAS.LE.4) THEN 481 : CALL CRITPE (SIGTP(IHARD),SIGHP0(IHARD),RESIST(ICAS), 482 : & ISGNTC,FFF(ICAS)) 483 : ELSE 484 : FG(1) = XKISOI(ICAS-4)*RESIST(ICAS) 484 : CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,FINT1) 484 : CALL CRITPE (SIGTP(IHARDC),XZER,FG(1),ISGNTC,FINT2) 485 : FFF(ICAS) = MAX(FINT1,FINT2) 486 : ENDIF 487 : C 488 : C Calcul de la normale et du jacobien 489 : C 490 : IF (ICAS.LE.4) THEN 490 : CALL NORMBL(SIGT,RESIST(ICAS),ISGNTC,ISGN2,1,XNOR1) 491 : XJ00(1,1) = -XXCCYY(XNOR1, XNOR1, YOUN, XNU)-XHH1 492 : ELSE 492 : CALL NORMBL(SIGT,RESIST(ICAS),ISGNTC,ISGN2,2,XNOR1) 493 : XJ00(1,1) = -XXCCYY(XNOR1,XNOR1,YOUN,XNU) 494 : & -ISGNTC*RESIST(ICAS)*XHH2 495 : ENDIF 496 : C 497 : R(1) = + FFF(ICAS) 498 : GAMBDA(1)=XZER 499 : GAMBDA(2)=XZER 500 : GAMBDA(3)=XZER 501 : GAMBDA(4)=XZER 502 : GAMBDA(5)=XZER 503 : GAMBDA(6)=XZER 504 : C 505 : XJ0INV = UN/XJ00(1,1) 506 : C 506 : CALL ZERO(D,1,MN) 507 : XH0(1,1) = XJ0INV 508 : C 509 : C On rentre dans les iterations internes 510 : C 511 : DO I=0,ITM 512 : C 513 : C Appel de Broyden 514 : C 514 : CALL BROYDE (QUASIN) 515 : C 516 : GAMBDA(ICAS) = D(1) 517 : C 518 : C Calcul du phi et des termes de la matrice A et A-1 519 : C 520 : SITPRO(1) = SIGI(1) + DSIGI(1) 521 : & - UNDEMI*(GAMBDA(1) + GAMBDA(2) + GAMBDA(5))*CPI 522 : & + UNDEMI*(GAMBDA(3) + GAMBDA(4) + GAMBDA(6))*CPI 523 : SITPRO(2) = SIGI(2) + DSIGI(2) 524 : & - UNDEMI*(GAMBDA(1) + GAMBDA(2) + GAMBDA(5))*CPI 525 : & + UNDEMI*(GAMBDA(3) + GAMBDA(4) + GAMBDA(6))*CPI 526 : SITPRO(4) = SIGI(4) + DSIGI(4) 527 : C 528 : C Mis a jour des variables d'ecrouissage 529 : C 530 : SIGHP(1) = SIGHP0(1) + XHH1*(GAMBDA(1)-GAMBDA(3)) 531 : SIGHP(2) = SIGHP0(2) + XHH1*(GAMBDA(2)-GAMBDA(4)) 532 : EPSI(1) = EPSI0(1) + GAMBDA(5) 533 : IF (ICAS.LE.4) THEN 534 : WORK = GAMBDA(ICAS)*RESIST(ICAS)*ISGNTC 535 : ELSE 536 : WORK = XZER 537 : ENDIF 538 : EPSI(2) = EPSI0(2) + GAMBDA(6) + DEGRAD*WORK 539 : C 540 : IF (ICAS.LE.4) THEN 540 : CALL VALEUR(EPSI(1),TRAC(IPT),NCURVT,XLCAT, 541 : &XKISO(1),DUMM,KERRE) 541 : CALL VALEUR(EPSI(2),TRAC(IPC),NCURVC,XLCAC, 542 : &XKISO(2),DUMM,KERRE) 543 : ELSE 544 : IF (ICAS.EQ.5) THEN 544 : CALL VALEUR(EPSI(1),TRAC(IPT),NCURVT,XLCAT, 545 : &XKISO(1),XHH2,KERRE) 545 : CALL VALEUR(EPSI(2),TRAC(IPC),NCURVC,XLCAC, 546 : &XKISO(2),DUMM,KERRE) 547 : ELSE 547 : CALL VALEUR(EPSI(1),TRAC(IPT),NCURVT,XLCAT, 548 : &XKISO(1),DUMM,KERRE) 548 : CALL VALEUR(EPSI(2),TRAC(IPC),NCURVC,XLCAC, 549 : &XKISO(2),XHH2,KERRE) 550 : ENDIF 551 : ENDIF 552 : C 553 : C Calcul des phi 554 : C 555 : IF (ICAS.LE.4) THEN 556 : PHI = ISGNTC*(-UNDEMI*(SITPRO(1) + SITPRO(2)) + SIGHP(IHARD) 557 : & + RESIST(ICAS)) 558 : ELSE 559 : PHI = ISGNTC*(-UNDEMI*(SITPRO(1)+SITPRO(2)) 560 : & +(XKISOI(ICAS - 4)+(EPSI(ICAS-4) - EPSII(ICAS-4))*XHH2I) 561 : & *RESIST(ICAS)) 562 : ENDIF 563 : C 564 : C Calcul de AINV 565 : C 566 : SOMLAM = GAMBDA(1) + GAMBDA(2) + GAMBDA(3) + GAMBDA(4) 567 : & + GAMBDA(5) + GAMBDA(6) 568 : AINV(1) = (DEUX*PHI+GGG*SOMLAM)/(DEUX*PHI+DEUX*GGG*SOMLAM) 569 : AINV(2) = GGG*SOMLAM/(DEUX*PHI + DEUX*GGG*SOMLAM) 570 : AINV(3) = PHI/(PHI + (GGG*SOMLAM)) 571 : C 572 : C Calcul des contraintes a l'aide de AINV 573 : C 574 : SIGT(1) = AINV(1)*SITPRO(1) + AINV(2)*SITPRO(2) 575 : SIGT(2) = AINV(2)*SITPRO(1) + AINV(1)*SITPRO(2) 576 : SIGT(4) = AINV(3)*SITPRO(4) 577 : C 578 : C Nouvelles contraintes principales 579 : C 579 : CALL CONPRI (SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI) 580 : C 581 : C 582 : IF (ICAS.LE.4) THEN 582 : CALL CRITPE (SIGTP(IHARD),SIGHP(IHARD),RESIST(ICAS), 583 : & ISGNTC,FFF(ICAS)) 584 : R(1)= + FFF(ICAS) 585 : ELSE 586 : FG(1) = (XKISOI(ICAS-4)+(EPSI(ICAS-4)-EPSII(ICAS-4))*XHH2I) 587 : & *RESIST(ICAS) 588 : C 588 : CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,FINT1) 588 : CALL CRITPE (SIGTP(IHARDC),XZER,FG(1),ISGNTC,FINT2) 589 : FFF(ICAS) = MAX (FINT1,FINT2) 590 : C 591 : R(1) = + FFF(ICAS) 592 : & - ISGNTC*RESIST(ICAS) 593 : & * (XKISO(ICAS-4) - XKISOI(ICAS-4) 594 : & -(EPSI(ICAS-4) - EPSII(ICAS-4))*XHH2I) 595 : IF (ABS(EPSI(ICAS-4) - EPSII(ICAS-4)).LT.EPSILO2) THEN 596 : XHH2I=XHH2 597 : ELSE 598 : XHH2I = (XKISO(ICAS-4) - XKISOI(ICAS-4))/ 599 : & (EPSI(ICAS-4) - EPSII(ICAS-4)) 600 : ENDIF 601 : XKISOI(ICAS-4) = XKISO(ICAS-4) 602 : EPSII(ICAS-4) = EPSI(ICAS-4) 603 : ENDIF 604 : C 605 : C Test de convergence 606 : C 607 : C IF (ABS(FFF(ICAS)).LT.EPSIL(ICAS)) GOTO 1020 608 : IF ((ABS(FFF(ICAS)).LT.EPSIL(ICAS)) 609 : & .AND.(ABS(R(1)).LT.EPSIL(ICAS))) GOTO 1020 610 : ENDDO 611 : C 612 : C Pas de convergence 613 : C 614 : SEGSUP,QUASIN 615 : GOTO 6000 616 : C 617 : 1020 CONTINUE 618 : SEGSUP,QUASIN 619 : C 620 : IF (GAMBDA(ICAS).LT.EPSILO2) THEN 621 : WRITE (IOIMP,*)'BETOCY: Multiplicateurs plastiques < 0' 622 : KERRE = 2 623 : RETURN 624 : ELSE 625 : CONTINUE 626 : ENDIF 627 : C 628 : C On verifie qu'on ne viole pas les autres criteres 629 : C 630 : IF (IHARD.EQ.2) THEN 631 : IHARDC=1 632 : ELSE 633 : IHARDC=2 634 : ENDIF 635 : C 636 : IF (ICAS.LE.2) THEN 637 : FG(1) = XKISO(1)*RESIST(5) 638 : FG(2) = XKISO(2)*RESIST(6) 639 : ELSE 640 : IF (ICAS.LE.4) THEN 641 : FG(1) = XKISO(2)*RESIST(6) 642 : FG(2) = XKISO(1)*RESIST(5) 643 : ELSE 644 : IF (ICAS.EQ.5) THEN 645 : FG(1) = XKISO(1)*RESIST(5) 646 : FG(2) = XKISO(2)*RESIST(6) 647 : ELSE 648 : FG(1) = XKISO(2)*RESIST(6) 649 : FG(2) = XKISO(1)*RESIST(5) 650 : ENDIF 651 : ENDIF 652 : ENDIF 653 : C 654 : C Test GS 655 : C 656 : IF (ICAS.GE.5) THEN 657 : C Regles de suivi si on est sur la grande surface 658 : C 1- Direction de l'ecoulement 659 : SIGHP(IHARD) = FG(1) -RESIST(2*ICAS-10+IHARD) 660 : C 2- Direction perpendiculaire a l'ecoulement 661 : C (si on se trouve dans le coin) 662 : XLIMIT = FG(1) -RESIST(2*ICAS-10+IHARDC) 663 : IF (ISGNTC*(SIGHP(IHARDC)-XLIMIT).GT.XZER) THEN 664 : SIGHP(IHARDC) = XLIMIT 665 : KONTAC(2*ICAS-10+IHARDC)=1 666 : ENDIF 667 : ENDIF 668 : C 669 : C 670 : C On teste les autres mecanismes 671 : C 672 : C Test des contacts lateraux 673 : C Meme signe signtc 674 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) THEN 675 : ICASB = ICAS + 1 676 : ELSE 677 : IF ((ICAS.EQ.2).OR.(ICAS.EQ.4)) THEN 678 : ICASB = ICAS -1 679 : ELSE 680 : ICASB = 2*ICAS-10+IHARDC 681 : ENDIF 682 : ENDIF 683 : IF (KONTAC(ICASB).EQ.0) THEN 683 : CALL CRITPE(SIGTP(IHARDC), SIGHP(IHARDC), RESIST(ICASB), 684 : &ISGNTC,XFFFS) 685 : IF (((XFFFS.GE.EPSIL(5)).AND.(ICASB.LE.2)).OR. 686 : &((XFFFS.GE.EPSIL(6)).AND.(ICASB.GE.3))) THEN 687 : IHARDB = IHARDC 688 : ISGNTCB = ISGNTC 689 : GOTO 1100 690 : ELSE 691 : IF (((ABS(XFFFS).LT.EPSIL(5)).AND.(ICASB.LE.2)).OR. 692 : &((ABS(XFFFS).LT.EPSIL(6)).AND.(ICASB.GE.3))) THEN 693 : KONTAC(ICASB)=1 694 : ENDIF 695 : ENDIF 696 : ELSE 696 : CALL CRITPE(SIGTP(IHARDC), XZER, FG(1), ISGNTC,XFFFS) 697 : IF (ICASB.LE.2) THEN 698 : ICASB = 5 699 : ELSE 700 : ICASB = 6 701 : ENDIF 702 : IF (XFFFS.GE.EPSIL(ICASB)) THEN 703 : IHARDB = IHARDC 704 : ISGNTCB = ISGNTC 705 : GOTO 1100 706 : ENDIF 707 : ENDIF 708 : C Autre signe signtc 709 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) THEN 710 : ICASB = ICAS + 1 711 : ELSE 712 : IF ((ICAS.EQ.2).OR.(ICAS.EQ.4)) THEN 713 : ICASB = ICAS - 1 714 : ELSE 715 : ICASB = 2*ICAS-10+IHARDC 716 : ENDIF 717 : ENDIF 718 : IF (ICASB.LE.2) THEN 719 : ICASB = ICASB +2 720 : ELSE 721 : ICASB = ICASB -2 722 : ENDIF 723 : IF (KONTAC(ICASB).EQ.0) THEN 723 : CALL CRITPE(SIGTP(IHARDC), SIGHP(IHARDC), RESIST(ICASB), 724 : &-ISGNTC,XFFFS) 725 : IF (((XFFFS.GE.EPSIL(5)).AND.(ICASB.LE.2)).OR. 726 : &((XFFFS.GE.EPSIL(6)).AND.(ICASB.GE.3))) THEN 727 : IHARDB = IHARDC 728 : ISGNTCB = -ISGNTC 729 : GOTO 1100 730 : ELSE 731 : IF (((ABS(XFFFS).LT.EPSIL(5)).AND.(ICASB.LE.2)).OR. 732 : &((ABS(XFFFS).LT.EPSIL(6)).AND.(ICASB.GE.3))) THEN 733 : KONTAC(ICASB)=1 734 : ENDIF 735 : ENDIF 736 : ELSE 736 : CALL CRITPE(SIGTP(IHARDC), XZER, FG(2), -ISGNTC,XFFFS) 737 : IF (ICASB.LE.2) THEN 738 : ICASB = 5 739 : ELSE 740 : ICASB = 6 741 : ENDIF 742 : IF (XFFFS.GE.EPSIL(ICASB)) THEN 743 : IHARDB = IHARDC 744 : ISGNTCB = -ISGNTC 745 : GOTO 1100 746 : ENDIF 747 : ENDIF 748 : C Test du contact frontal 749 : IF (ICAS.LE.4) THEN 749 : CALL CRITPE(SIGTP(IHARD), XZER, FG(1), ISGNTC,XFFFS) 750 : IF (((XFFFS.GE.EPSIL(5)).AND.(ICAS.LE.2)).OR. 751 : &((XFFFS.GE.EPSIL(6)).AND.(ICAS.GE.3))) THEN 752 : GOTO 1040 753 : ELSE 754 : IF (((ABS(XFFFS).LT.EPSIL(5)).AND.(ICAS.LE.2)).OR. 755 : &((ABS(XFFFS).LT.EPSIL(6)).AND.(ICAS.GE.3))) THEN 756 : KONTAC(ICAS) = 1 757 : ENDIF 758 : ENDIF 759 : ENDIF 760 : C 761 : C Il faut faire suivre la petite surface si la grande se retrecit trop vite 762 : C 763 : IF (ICAS.LE.4) THEN 764 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) THEN 765 : ICASB = ICAS +1 766 : ELSE 767 : ICASB = ICAS -1 768 : ENDIF 769 : XLIMIT = FG(1) -RESIST(ICASB) 770 : IF (ISGNTC*(SIGHP(IHARDC)-XLIMIT).GT.XZER) THEN 771 : SIGHP(IHARDC) = XLIMIT 772 : KONTAC(ICASB) = 1 773 : ENDIF 774 : IF (ICASB.LE.2) THEN 775 : ICASB = ICASB +2 776 : ELSE 777 : ICASB = ICASB -2 778 : ENDIF 779 : XLIMIT = FG(2) -RESIST(ICASB) 780 : IF (-ISGNTC*(SIGHP(IHARDC)-XLIMIT).GT.XZER) THEN 781 : SIGHP(IHARDC) = XLIMIT 782 : KONTAC(ICASB) = 1 783 : ENDIF 784 : ENDIF 785 : C 786 : C Mis a jour des indicateurs de contact 787 : C 788 : IF ((XKISO(1)*RESIST(5)-XKISO(2)*RESIST(6)).GT. 789 : &(RESIST(1)-RESIST(3))) THEN 790 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) KONTAC(ICAS+2)=0 791 : IF ((ICAS.EQ.3).OR.(ICAS.EQ.4)) KONTAC(ICAS-2)=0 792 : ELSE 793 : KONTAC(1) = 1 794 : KONTAC(2) = 1 795 : KONTAC(3) = 1 796 : KONTAC(4) = 1 797 : ENDIF 798 : C 799 : ICASB = ICAS 800 : GOTO 9999 801 : C 802 : C Cas ou on trouve le contact frontal 803 : C 804 : 1040 CONTINUE 805 : SIGHP(1) = SIGHP0(1) 806 : SIGHP(2) = SIGHP0(2) 807 : SIGT(1) = SIGI(1) + DSIGI(1) 808 : SIGT(2) = SIGI(2) + DSIGI(2) 809 : SIGT(4) = SIGI(4) + DSIGI(4) 810 : GOTO 3000 811 : C 812 : C Cas ou on viole un critere lateral 813 : C 814 : 1100 CONTINUE 815 : SIGHP(1) = SIGHP0(1) 816 : SIGHP(2) = SIGHP0(2) 817 : SIGT(1) = SIGI(1) + DSIGI(1) 818 : SIGT(2) = SIGI(2) + DSIGI(2) 819 : SIGT(4) = SIGI(4) + DSIGI(4) 820 : IF (ICAS.EQ.ICASB) THEN 821 : IF (ICAS.GE.5) THEN 822 : GOTO 1000 823 : ELSE 824 : KERRE = 2 825 : RETURN 826 : ENDIF 827 : ELSE 828 : GOTO 4000 829 : ENDIF 830 : C================================================================ 831 : C CAS 2 832 : C Un seul mecanisme de chaque surface 833 : C mais entree en contact des 2 mecanismes 834 : C================================================================ 835 : 3000 CONTINUE 836 : C 836 : CALL CONPRI (SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI) 837 : C 838 : C 839 : C Calcul de la normale a l'estimation elastique et du jacobien initial 840 : C 841 : IF (IHARD.EQ.1) THEN 842 : IF (SIGTP(1).GE.SIGTP(2)) THEN 843 : ISGN2 = 1 844 : ELSE 845 : ISGN2 = -1 846 : ENDIF 847 : ELSE 848 : IF (IHARD.EQ.2) THEN 849 : IF (SIGTP(2).GE.SIGTP(1)) THEN 850 : ISGN2 = 1 851 : ELSE 852 : ISGN2 = -1 853 : ENDIF 854 : ENDIF 855 : ENDIF 856 : C 857 : 3010 CONTINUE 858 : C 859 : C Definition du segment 860 : C 861 : ITM = 30 862 : MN = 2 863 : SEGINI,QUASIN 864 : IT = -1 864 : CALL ZERO(D,1,MN) 865 : C 866 : C Calcul de xhh2 et xkiso 867 : C 868 : IF (ICAS.LE.2) THEN 868 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT, 869 : &XKISO(1),XHH2,KERRE) 869 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC, 870 : &XKISO(2),DUMM,KERRE) 871 : ELSE 871 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT, 872 : &XKISO(1),DUMM,KERRE) 872 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC, 873 : &XKISO(2),XHH2,KERRE) 874 : ENDIF 875 : EPSI(1) = EPSI0(1) 876 : XKISO0(1) = XKISO(1) 877 : EPSI(2) = EPSI0(2) 878 : XKISO0(2) = XKISO(2) 879 : XHH2I = XHH2 880 : EPSII(1) = EPSI0(1) 881 : XKISOI(1) = XKISO(1) 882 : EPSII(2) = EPSI0(2) 883 : XKISOI(2) = XKISO(2) 884 : C 885 : DO 3011,IE1=1,6 886 : FFF(IE1) = XZER 887 : 3011 CONTINUE 888 : C 889 : IF (ISGNTC.GT.0) THEN 890 : FG(1) = XKISO(1)*RESIST(5) 891 : ELSE 892 : FG(1) = XKISO(2)*RESIST(6) 893 : ENDIF 893 : CALL CRITPE (SIGTP(IHARD),SIGHP0(IHARD) 894 : & ,RESIST(ICAS),ISGNTC,FFF(ICAS)) 894 : CALL CRITPE (SIGTP(IHARD), XZER, FG(1), ISGNTC, XFFFS) 895 : C 895 : CALL NORMBL(SIGT,RESIST(ICAS),ISGNTC,ISGN2,1,XNOR1) 896 : XJ00(1,1) = -XXCCYY(XNOR1, XNOR1, YOUN, XNU)-XHH1 897 : XJ00(2,2) = -XXYY(XNOR1,DSIGI) 898 : XJ00(1,2) = -XXYY(XNOR1,DSIGI) 899 : XJ00(2,1) = -XXCCYY(XNOR1, XNOR1, YOUN, XNU) 900 : IF (ISGNTC.LT.0) THEN 901 : XJ00(2,1)=XJ00(2,1)+RESIST(6)*XHH2*DEGRAD*ISGNTC*RESIST(ICAS) 902 : ENDIF 903 : R(1) = FFF(ICAS) 904 : R(2) = XFFFS 905 : GAMBDA(1)=XZER 906 : GAMBDA(2)=XZER 907 : GAMBDA(3)=XZER 908 : GAMBDA(4)=XZER 909 : GAMBDA(5)=XZER 910 : GAMBDA(6)=XZER 911 : C 912 : C Inverse du jacobien 913 : C 914 : XH0(1,1) = XJ00(1,1) 915 : XH0(1,2) = XJ00(1,2) 916 : XH0(2,1) = XJ00(2,1) 917 : XH0(2,2) = XJ00(2,2) 917 : CALL INVALM (XH0, MN , MN , IRD, 1.D-12) 918 : IF (IRD.NE.0) THEN 919 : SEGSUP,QUASIN 920 : GOTO 6000 921 : ENDIF 922 : C 923 : C On rentre dans les iterations internes 924 : C 925 : DO I=0,ITM 926 : C 927 : C Appel de Broyden 928 : C 928 : CALL BROYDE (QUASIN) 929 : C 930 : GAMBDA(ICAS) = D(1) 931 : SPLITT = D(2) 932 : C 933 : C Calcul du phi et des termes de la matrice A et A-1 934 : C 935 : SITPRO(1) = SIGI(1) + ((UN-SPLITT)*DSIGI(1)) 936 : & - UNDEMI*(GAMBDA(1) + GAMBDA(2))*CPI 937 : & + UNDEMI*(GAMBDA(3) + GAMBDA(4))*CPI 938 : SITPRO(2) = SIGI(2) + ((UN-SPLITT)*DSIGI(2)) 939 : & - UNDEMI*(GAMBDA(1) + GAMBDA(2))*CPI 940 : & + UNDEMI*(GAMBDA(3) + GAMBDA(4))*CPI 941 : SITPRO(4) = SIGI(4) + (UN-SPLITT)*DSIGI(4) 942 : C 943 : SIGHP(1) = SIGHP0(1) + XHH1*(GAMBDA(1)-GAMBDA(3)) 944 : SIGHP(2) = SIGHP0(2) + XHH1*(GAMBDA(2)-GAMBDA(4)) 945 : EPSI(1) = EPSI0(1) 946 : WORK = GAMBDA(ICAS)*ISGNTC*RESIST(ICAS) 947 : EPSI(2) = EPSI0(2) + DEGRAD*WORK 947 : CALL VALEUR(EPSI(2),TRAC(IPC),NCURVC,XLCAC, 948 : &XKISO(2),XHH2,KERRE) 949 : C 950 : PHI = ISGNTC*(-UNDEMI*(SITPRO(1)+SITPRO(2))+SIGHP(IHARD) 951 : & + RESIST(ICAS)) 952 : C 953 : C 954 : SOMLAM = GAMBDA(1) + GAMBDA(2) + GAMBDA(3) + GAMBDA(4) 955 : AINV(1) = (DEUX*PHI+GGG*SOMLAM)/(DEUX*PHI+DEUX*GGG*SOMLAM) 956 : AINV(2) = GGG*SOMLAM/(DEUX*PHI + DEUX*GGG*SOMLAM) 957 : AINV(3) = PHI/(PHI + GGG*SOMLAM) 958 : C 959 : C Calcul des contraintes a l'aide de AINV 960 : C 961 : SIGT(1) = AINV(1)*SITPRO(1)+AINV(2)*SITPRO(2) 962 : SIGT(2) = AINV(2)*SITPRO(1)+AINV(1)*SITPRO(2) 963 : SIGT(4) = AINV(3)*SITPRO(4) 964 : C 965 : C Nouvelles contraintes principales 966 : C 966 : CALL CONPRI (SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI) 967 : C 968 : NMEC = 0 969 : C 970 : IF (ISGNTC.GT.0) THEN 971 : FG(1) = XKISO(1)*RESIST(5) 972 : ELSE 973 : FG(1) = (XKISOI(2) + XHH2I*(EPSI(2)-EPSII(2)))*RESIST(6) 974 : ENDIF 974 : CALL CRITPE (SIGTP(IHARD),SIGHP(IHARD) 975 : & ,RESIST(ICAS),ISGNTC,FFF(ICAS)) 976 : R(1) = + FFF(ICAS) 977 : IF (ABS(FFF(ICAS)).GE.EPSIL(ICAS)) THEN 978 : NMEC = NMEC + 1 979 : ENDIF 979 : CALL CRITPE (SIGTP(IHARD), XZER, FG(1), ISGNTC, XFFFS) 980 : R(2) = XFFFS 981 : IF (ICAS.GE.3) THEN 982 : R(2) = R(2) + RESIST(6)*(XKISO(2) - XKISOI(2) 983 : & - (EPSI(2) - EPSII(2))*XHH2I) 984 : IF (ABS(EPSI(2) - EPSII(2)).LT.EPSILO2) THEN 985 : XHH2I=XHH2 986 : ELSE 987 : XHH2I = (XKISO(2) - XKISOI(2))/ 988 : & (EPSI(2) - EPSII(2)) 989 : ENDIF 990 : EPSII(2) = EPSI(2) 991 : XKISOI(2) = XKISO(2) 992 : ENDIF 993 : IF (((ABS(XFFFS).GE.EPSIL(5)).AND.(ICAS.LE.2)).OR. 994 : &((ABS(XFFFS).GE.EPSIL(6)).AND.(ICAS.GE.3))) THEN 995 : NMEC = NMEC + 1 996 : ENDIF 997 : C 998 : C Test de convergence 999 : C 1000 : IF (NMEC.EQ.0) GOTO 3020 1001 : ENDDO 1002 : C 1003 : C Pas de convergence 1004 : C 1005 : SEGSUP,QUASIN 1006 : GOTO 6000 1007 : C 1008 : 3020 CONTINUE 1009 : C 1010 : C On verifie que la convergence ne s'est pas faite sur un point debile 1011 : C 1012 : SEGSUP,QUASIN 1013 : IF (((SPLITT-1.).LE.EPSILO).AND.(SPLITT.GE.(-1.*EPSILO))) THEN 1014 : C 1015 : IF (IHARD.EQ.2) THEN 1016 : IHARDC=1 1017 : ELSE 1018 : IHARDC=2 1019 : ENDIF 1020 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) ICASC = ICAS + 1 1021 : IF ((ICAS.EQ.2).OR.(ICAS.EQ.4)) ICASC = ICAS - 1 1022 : C 1023 : IF (ICAS.LE.2) THEN 1024 : FG(1) = XKISO(1)*RESIST(5) 1025 : FG(2) = XKISO(2)*RESIST(6) 1026 : ELSE 1027 : FG(1) = XKISO(2)*RESIST(6) 1028 : FG(2) = XKISO(1)*RESIST(5) 1029 : ENDIF 1030 : C 1031 : C Test des contacts lateraux 1032 : C Meme signe signtc 1033 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) THEN 1034 : ICASB = ICAS + 1 1035 : ELSE 1036 : ICASB = ICAS -1 1037 : ENDIF 1038 : IF (KONTAC(ICASB).EQ.0) THEN 1038 : CALL CRITPE(SIGTP(IHARDC), SIGHP(IHARDC), 1039 : & RESIST(ICASB), ISGNTC,XFFFS) 1040 : IF (((XFFFS.GE.EPSIL(5)).AND.(ICASB.LE.2)).OR. 1041 : &((XFFFS.GE.EPSIL(6)).AND.(ICASB.GE.3))) THEN 1042 : IHARDB = IHARDC 1043 : ISGNTCB = ISGNTC 1044 : GOTO 3100 1045 : ELSE 1046 : IF (((ABS(XFFFS).LT.EPSIL(5)).AND.(ICASB.LE.2)).OR. 1047 : &((ABS(XFFFS).LT.EPSIL(6)).AND.(ICASB.GE.3))) THEN 1048 : KONTAC(ICASB)=1 1049 : ENDIF 1050 : ENDIF 1051 : ELSE 1051 : CALL CRITPE(SIGTP(IHARDC), XZER, FG(1), ISGNTC,XFFFS) 1052 : IF (ICASB.LE.2) THEN 1053 : ICASB = 5 1054 : ELSE 1055 : ICASB = 6 1056 : ENDIF 1057 : IF (XFFFS.GE.EPSIL(ICASB)) THEN 1058 : IHARDB = IHARDC 1059 : ISGNTCB = -ISGNTC 1060 : GOTO 3100 1061 : ENDIF 1062 : ENDIF 1063 : C Autre signe signtc 1064 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) THEN 1065 : ICASB = ICAS + 1 1066 : ELSE 1067 : ICASB = ICAS -1 1068 : ENDIF 1069 : IF (ICASB.LE.2) THEN 1070 : ICASB = ICASB +2 1071 : ELSE 1072 : ICASB = ICASB -2 1073 : ENDIF 1074 : IF (KONTAC(ICASB).EQ.0) THEN 1074 : CALL CRITPE(SIGTP(IHARDC), SIGHP(IHARDC),RESIST(ICASB), 1075 : & -ISGNTC,XFFFS) 1076 : IF (((XFFFS.GE.EPSIL(5)).AND.(ICASB.LE.2)).OR. 1077 : &((XFFFS.GE.EPSIL(6)).AND.(ICASB.GE.3))) THEN 1078 : IHARDB = IHARDC 1079 : ISGNTCB = ISGNTC 1080 : GOTO 3100 1081 : ELSE 1082 : IF (((ABS(XFFFS).LT.EPSIL(5)).AND.(ICASB.LE.2)).OR. 1083 : &((ABS(XFFFS).LT.EPSIL(6)).AND.(ICASB.GE.3))) THEN 1084 : KONTAC(ICASB)=1 1085 : ENDIF 1086 : ENDIF 1087 : ELSE 1087 : CALL CRITPE(SIGTP(IHARDC), XZER, FG(2), -ISGNTC,XFFFS) 1088 : IF (ICASB.LE.2) THEN 1089 : ICASB = 5 1090 : ELSE 1091 : ICASB = 6 1092 : ENDIF 1093 : IF (XFFFS.GE.EPSIL(ICASB)) THEN 1094 : IHARDB = IHARDC 1095 : ISGNTCB = -ISGNTC 1096 : GOTO 3100 1097 : ENDIF 1098 : ENDIF 1099 : C 1100 : C Il faut faire suivre la petite surface si la grande se retrecit trop vite 1101 : C 1102 : IF (ICAS.LE.4) THEN 1103 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.3)) THEN 1104 : ICASB = ICAS +1 1105 : ELSE 1106 : ICASB = ICAS -1 1107 : ENDIF 1108 : XLIMIT = FG(1) -RESIST(ICASB) 1109 : IF (ISGNTC*(SIGHP(IHARDC)-XLIMIT).GT.XZER) THEN 1110 : SIGHP(IHARDC) = XLIMIT 1111 : KONTAC(ICASB) = 1 1112 : ENDIF 1113 : IF (ICASB.LE.2) THEN 1114 : ICASB = ICASB +2 1115 : ELSE 1116 : ICASB = ICASB -2 1117 : ENDIF 1118 : XLIMIT = FG(2) -RESIST(ICASB) 1119 : IF (-ISGNTC*(SIGHP(IHARDC)-XLIMIT).GT.XZER) THEN 1120 : SIGHP(IHARDC) = XLIMIT 1121 : KONTAC(ICASB) = 1 1122 : ENDIF 1123 : ENDIF 1124 : C 1125 : C 1126 : C Mis a jour des indicateurs de contact 1127 : C 1128 : KONTAC(ICAS) = 1 1129 : IF ((XKISO(1)*RESIST(5)-XKISO(2)*RESIST(6)).GT. 1130 : &(RESIST(1)-RESIST(3))) THEN 1131 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) KONTAC(ICAS+2)=0 1132 : IF ((ICAS.EQ.3).OR.(ICAS.EQ.4)) KONTAC(ICAS-2)=0 1133 : ELSE 1134 : KONTAC(1) = 1 1135 : KONTAC(2) = 1 1136 : KONTAC(3) = 1 1137 : KONTAC(4) = 1 1138 : ENDIF 1139 : SIGI(1) = SIGT(1) 1140 : SIGI(2) = SIGT(2) 1141 : SIGI(4) = SIGT(4) 1142 : DSIGI(1) = DSIGI(1)*SPLITT 1143 : DSIGI(2) = DSIGI(2)*SPLITT 1144 : DSIGI(4) = DSIGI(4)*SPLITT 1145 : SIGT(1) = SIGI(1) + DSIGI(1) 1146 : SIGT(2) = SIGI(2) + DSIGI(2) 1147 : SIGT(4) = SIGI(4) + DSIGI(4) 1148 : SIGHP0(1) = SIGHP(1) 1149 : SIGHP0(2) = SIGHP(2) 1150 : EPSI0(1) = EPSI(1) 1151 : EPSI0(2) = EPSI(2) 1152 : CPHI0 = CPHI 1153 : SPHI0 = SPHI 1154 : NPASS2 = 0 1155 : IF (ICAS.LE.2) THEN 1156 : ICAS = 5 1157 : ELSE 1158 : ICAS = 6 1159 : ENDIF 1160 : GOTO 1000 1161 : C 1162 : C 1163 : ELSE 1164 : GOTO 6000 1165 : ENDIF 1166 : C 1167 : C Cas ou on viole un critere lateral 1168 : C 1169 : 3100 CONTINUE 1170 : SIGHP(1) = SIGHP0(1) 1171 : SIGHP(2) = SIGHP0(2) 1172 : SIGT(1) = SIGI(1) + DSIGI(1) 1173 : SIGT(2) = SIGI(2) + DSIGI(2) 1174 : SIGT(4) = SIGI(4) + DSIGI(4) 1174 : CALL CONPRI ( SIGT ,CPHI0,SPHI0,SIGTP,CPHI,SPHI) 1174 : CALL VALEUR(EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1), 1175 : &DUMM,KERRE) 1175 : CALL VALEUR(EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2), 1176 : &DUMM,KERRE) 1176 : CALL CRITPE(SIGTP(IHARD), SIGHP(IHARD), RESIST(ICAS), 1177 : & ISGNTC, FFF(ICAS)) 1178 : IF (ICASB.LE.4) THEN 1178 : CALL CRITPE(SIGTP(IHARDB), SIGHP(IHARDB), RESIST(ICASB), 1179 : & ISGNTCB, FFF(ICASB)) 1180 : ELSE 1181 : FG(1) = XKISO(ICASB-4)*RESIST(ICASB) 1181 : CALL CRITPE (SIGTP(IHARDB), XZER, FG(1), 1182 : & ISGNTCB,FFF(ICASB)) 1183 : ENDIF 1184 : IF (ICAS.LE.2) THEN 1185 : FG(1) = XKISO(1)*RESIST(5) 1186 : ELSE 1187 : FG(1) = XKISO(2)*RESIST(6) 1188 : ENDIF 1188 : CALL CRITPE (SIGTP(IHARD), XZER, FG(1), ISGNTC, XFFFS) 1189 : GOTO 5000 1190 : C================================================================ 1191 : C CAS 4 1192 : C Deux mecanismes 1193 : C Petite et Grande surfaces (18/07) 1194 : C================================================================ 1195 : 4000 CONTINUE 1196 : C 1196 : CALL CONPRI ( SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI) 1197 : C 1198 : C 1199 : C Calcul de la normale a l'estimation elastique et du jacobien initial 1200 : C 1201 : IF (IHARD.EQ.1) THEN 1202 : IF (SIGTP(1).GE.SIGTP(2)) THEN 1203 : ISGN2 = 1 1204 : ELSE 1205 : ISGN2 = -1 1206 : ENDIF 1207 : ELSE 1208 : IF (IHARD.EQ.2) THEN 1209 : IF (SIGTP(2).GE.SIGTP(1)) THEN 1210 : ISGN2 = 1 1211 : ELSE 1212 : ISGN2 = -1 1213 : ENDIF 1214 : ENDIF 1215 : ENDIF 1216 : C 1217 : IF (IHARDB.EQ.1) THEN 1218 : IF (SIGTP(1).GE.SIGTP(2)) THEN 1219 : ISGN2B = 1 1220 : ELSE 1221 : ISGN2B = -1 1222 : ENDIF 1223 : ELSE 1224 : IF (IHARDB.EQ.2) THEN 1225 : IF (SIGTP(1).GE.SIGTP(2)) THEN 1226 : ISGN2B = -1 1227 : ELSE 1228 : ISGN2B = 1 1229 : ENDIF 1230 : ENDIF 1231 : ENDIF 1232 : C 1233 : C 1234 : C 1235 : 4010 CONTINUE 1236 : C 1237 : C Definition du segment 1238 : C 1239 : ITM = 30 1240 : MN = 2 1241 : SEGINI,QUASIN 1242 : IT = -1 1242 : CALL ZERO(D,1,MN) 1243 : C 1244 : C XKISO et XHH2 1245 : C 1246 : IF (ICAS.LE.4) THEN 1247 : IF (ICASB.LE.4) THEN 1247 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT, 1248 : &XKISO(1),DUMM,KERRE) 1248 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC, 1249 : &XKISO(2),DUMM,KERRE) 1250 : ELSE 1251 : IF (ICASB.EQ.5) THEN 1251 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1252 : & ,XHH2B,KERRE) 1252 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1253 : & ,DUMM,KERRE) 1254 : ELSE 1254 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1255 : & ,DUMM,KERRE) 1255 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1256 : & ,XHH2B,KERRE) 1257 : ENDIF 1258 : ENDIF 1259 : ELSE 1260 : IF (ICASB.LE.4) THEN 1261 : IF (ICAS.EQ.5) THEN 1261 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1262 : & ,XHH2,KERRE) 1262 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1263 : & ,DUMM,KERRE) 1264 : ELSE 1264 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1265 : & ,DUMM,KERRE) 1265 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1266 : & ,XHH2,KERRE) 1267 : ENDIF 1268 : ELSE 1269 : IF (ICASB.EQ.5) THEN 1269 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1270 : & ,XHH2B,KERRE) 1270 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1271 : & ,XHH2,KERRE) 1272 : ELSE 1272 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1273 : & ,XHH2,KERRE) 1273 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1274 : & ,XHH2B,KERRE) 1275 : ENDIF 1276 : ENDIF 1277 : ENDIF 1278 : EPSI(1) = EPSI0(1) 1279 : EPSI(2) = EPSI0(2) 1280 : XHH2I = XHH2 1281 : XHH2IB = XHH2B 1282 : XKISO0(1) = XKISO(1) 1283 : XKISO0(2) = XKISO(2) 1284 : EPSII(1) = EPSI0(1) 1285 : EPSII(2) = EPSI0(2) 1286 : XKISOI(1) = XKISO(1) 1287 : XKISOI(2) = XKISO(2) 1288 : C 1289 : DO 4011,IE1=1,6 1290 : FFF(IE1) = XZER 1291 : 4011 CONTINUE 1292 : C 1293 : IF (ICAS.LE.4) THEN 1293 : CALL CRITPE (SIGTP(IHARD),SIGHP0(IHARD),RESIST(ICAS), 1294 : & ISGNTC,FFF(ICAS)) 1295 : ELSE 1296 : FG(1) = XKISOI(ICAS-4)*RESIST(ICAS) 1296 : CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,FFF(ICAS)) 1297 : ENDIF 1298 : C 1299 : IF (ICASB.LE.4) THEN 1299 : CALL CRITPE (SIGTP(IHARDB),SIGHP0(IHARDB),RESIST(ICASB), 1300 : & ISGNTCB,FFF(ICASB)) 1301 : ELSE 1302 : FG(1) = XKISOI(ICASB-4)*RESIST(ICASB) 1302 : CALL CRITPE (SIGTP(IHARDB),XZER,FG(1),ISGNTCB,FFF(ICASB)) 1303 : ENDIF 1304 : C 1305 : C Jcobien initial 1306 : C 1306 : CALL NORMBL(SIGT,RESIST(ICAS),ISGNTC,ISGN2,1,XNOR1) 1306 : CALL NORMBL(SIGT,RESIST(ICASB),ISGNTCB,ISGN2B,1,XNOR2) 1307 : C 1308 : XJ00(1,1) = -XXCCYY(XNOR1, XNOR1, YOUN, XNU) 1309 : XJ00(1,2) = -XXCCYY(XNOR1, XNOR2, YOUN, XNU) 1310 : XJ00(2,1) = -XXCCYY(XNOR2, XNOR1, YOUN, XNU) 1311 : XJ00(2,2) = -XXCCYY(XNOR2, XNOR2, YOUN, XNU) 1312 : C 1313 : C Premier Mecanisme 1314 : C 1315 : IF (ICAS.LE.4) THEN 1316 : XJ00(1,1) = XJ00(1,1) - XHH1 1317 : ELSE 1318 : XJ00(1,1) = XJ00(1,1)-ISGNTC*RESIST(ICAS)*XHH2 1319 : IF ((ICASB.LE.4).AND.(ICAS.EQ.6)) THEN 1320 : XJ00(1,2) = XJ00(1,2) 1321 : & +RESIST(6)*XHH2*DEGRAD*ISGNTCB*RESIST(ICASB) 1322 : ENDIF 1323 : ENDIF 1324 : C 1325 : C Second Mecanisme 1326 : C 1327 : IF (ICASB.LE.4) THEN 1328 : XJ00(2,2) = XJ00(2,2) - XHH1 1329 : ELSE 1330 : XJ00(2,2) = XJ00(2,2)-ISGNTCB*RESIST(ICASB)*XHH2B 1331 : IF ((ICAS.LE.4).AND.(ICASB.EQ.6)) THEN 1332 : XJ00(2,1) = XJ00(2,1) 1333 : & +RESIST(6)*XHH2B*DEGRAD*ISGNTC*RESIST(ICAS) 1334 : ENDIF 1335 : ENDIF 1336 : C 1337 : C 1338 : R(1) = + FFF(ICAS) 1339 : R(2) = + FFF(ICASB) 1340 : GAMBDA(1) = XZER 1341 : GAMBDA(2) = XZER 1342 : GAMBDA(3) = XZER 1343 : GAMBDA(4) = XZER 1344 : GAMBDA(5) = XZER 1345 : GAMBDA(6) = XZER 1346 : C 1347 : C Inverse du jacobien 1348 : C 1349 : XH0(1,1) = XJ00(1,1) 1350 : XH0(1,2) = XJ00(1,2) 1351 : XH0(2,1) = XJ00(2,1) 1352 : XH0(2,2) = XJ00(2,2) 1352 : CALL INVALM (XH0, MN , MN , IRD, 1.D-12) 1353 : IF (IRD.NE.0) THEN 1354 : SEGSUP,QUASIN 1355 : GOTO 6000 1356 : ENDIF 1357 : C 1358 : C On rentre dans les iterations internes 1359 : C 1360 : DO I=0,ITM 1361 : C 1362 : C Appel de Broyden 1363 : C 1363 : CALL BROYDE (QUASIN) 1364 : C 1365 : GAMBDA(ICAS) = D(1) 1366 : GAMBDA(ICASB) = D(2) 1367 : C 1368 : C Calcul du phi et des termes de la matrice A et A-1 1369 : C 1370 : SITPRO(1) = SIGI(1) + DSIGI(1) 1371 : & - UNDEMI*(GAMBDA(1) + GAMBDA(2) + GAMBDA(5))*CPI 1372 : & + UNDEMI*(GAMBDA(3) + GAMBDA(4) + GAMBDA(6))*CPI 1373 : SITPRO(2) = SIGI(2) + DSIGI(2) 1374 : & - UNDEMI*(GAMBDA(1) + GAMBDA(2) + GAMBDA(5))*CPI 1375 : & + UNDEMI*(GAMBDA(3) + GAMBDA(4) + GAMBDA(6))*CPI 1376 : SITPRO(4) = SIGI(4) + DSIGI(4) 1377 : C 1378 : C PHI et AINV 1379 : C 1380 : SIGHP(1) = SIGHP0(1) + XHH1*(GAMBDA(1)-GAMBDA(3)) 1381 : SIGHP(2) = SIGHP0(2) + XHH1*(GAMBDA(2)-GAMBDA(4)) 1382 : EPSI(1) = EPSI0(1) + GAMBDA(5) 1383 : IF (ICAS.LE.4) THEN 1384 : WORK = GAMBDA(ICAS)*RESIST(ICAS)*ISGNTC 1385 : ELSE 1386 : WORK = XZER 1387 : ENDIF 1388 : IF (ICASB.LE.4) THEN 1389 : WORK = WORK + GAMBDA(ICASB)*RESIST(ICASB)*ISGNTCB 1390 : ENDIF 1391 : EPSI(2) = EPSI0(2) + GAMBDA(6) + DEGRAD*WORK 1392 : C 1393 : IF (ICAS.LE.4) THEN 1394 : IF (ICASB.LE.4) THEN 1394 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT, 1395 : &XKISO(1),DUMM,KERRE) 1395 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC, 1396 : &XKISO(2),DUMM,KERRE) 1397 : ELSE 1398 : IF (ICASB.EQ.5) THEN 1398 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1399 : & ,XHH2B,KERRE) 1399 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1400 : & ,DUMM,KERRE) 1401 : ELSE 1401 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1402 : & ,DUMM,KERRE) 1402 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1403 : & ,XHH2B,KERRE) 1404 : ENDIF 1405 : ENDIF 1406 : ELSE 1407 : IF (ICASB.LE.4) THEN 1408 : IF (ICAS.EQ.5) THEN 1408 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1409 : & ,XHH2,KERRE) 1409 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1410 : & ,DUMM,KERRE) 1411 : ELSE 1411 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1412 : & ,DUMM,KERRE) 1412 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1413 : & ,XHH2,KERRE) 1414 : ENDIF 1415 : ELSE 1416 : IF (ICASB.EQ.5) THEN 1416 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1417 : & ,XHH2B,KERRE) 1417 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1418 : & ,XHH2,KERRE) 1419 : ELSE 1419 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1420 : & ,XHH2,KERRE) 1420 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1421 : & ,XHH2B,KERRE) 1422 : ENDIF 1423 : ENDIF 1424 : ENDIF 1425 : C 1426 : C Calcul des phi 1427 : C 1428 : IF (ICAS.LE.4) THEN 1429 : PHI1=ISGNTC*(-UNDEMI*(SITPRO(1) + SITPRO(2)) 1430 : & + SIGHP(IHARD) + RESIST(ICAS)) 1431 : ELSE 1432 : PHI1= ISGNTC*(-UNDEMI*(SITPRO(1)+SITPRO(2)) 1433 : & +(XKISOI(ICAS-4)+XHH2I*(EPSI(ICAS-4)-EPSII(ICAS-4))) 1434 : & *RESIST(ICAS)) 1435 : ENDIF 1436 : C 1437 : IF (ICASB.LE.4) THEN 1438 : PHI2=ISGNTCB*(-UNDEMI*(SITPRO(1) + SITPRO(2)) 1439 : & + SIGHP(IHARDB)+ RESIST(ICASB)) 1440 : ELSE 1441 : PHI2=ISGNTCB*(-UNDEMI*(SITPRO(1)+SITPRO(2)) 1442 : & +(XKISOI(ICASB-4)+XHH2IB*(EPSI(ICASB-4)-EPSII(ICASB-4))) 1443 : & *RESIST(ICASB)) 1444 : ENDIF 1445 : C 1446 : C Test sur phi1 et phi2 1447 : C 1448 : IF ((ABS(PHI2)).GT.(ABS(EPSILO*RESIST(ICASB)))) THEN 1449 : SOMLAM = GAMBDA(ICAS) + GAMBDA(ICASB)*PHI1/PHI2 1450 : PHI = PHI1 1451 : ELSE 1452 : IF ((ABS(PHI1)).GT.(ABS(EPSILO*RESIST(ICAS)))) THEN 1453 : SOMLAM = GAMBDA(ICASB) + GAMBDA(ICAS)*PHI2/PHI1 1454 : PHI = PHI2 1455 : ELSE 1456 : SOMLAM = GAMBDA(ICASB) + GAMBDA(ICAS) 1457 : PHI = PHI1 1458 : ENDIF 1459 : ENDIF 1460 : C 1461 : AINV(1) = (DEUX*PHI+GGG*SOMLAM)/(DEUX*PHI+DEUX*GGG*SOMLAM) 1462 : AINV(2) = (GGG*SOMLAM)/(DEUX*PHI + DEUX*GGG*SOMLAM) 1463 : AINV(3) = PHI/(PHI + GGG*SOMLAM) 1464 : C 1465 : C Calcul des contraintes a l'aide de AINV 1466 : C 1467 : SIGT(1) = AINV(1)*SITPRO(1)+AINV(2)*SITPRO(2) 1468 : SIGT(2) = AINV(2)*SITPRO(1)+AINV(1)*SITPRO(2) 1469 : SIGT(4) = AINV(3)*SITPRO(4) 1470 : C 1471 : C Nouvelles contraintes principales 1472 : C 1472 : CALL CONPRI ( SIGT,CPHI0,SPHI0,SIGTP,CPHI,SPHI) 1473 : C 1474 : C 1475 : IF (ICAS.LE.4) THEN 1475 : CALL CRITPE (SIGTP(IHARD),SIGHP(IHARD),RESIST(ICAS), 1476 : & ISGNTC,FFF(ICAS)) 1477 : R(1)= + FFF(ICAS) 1478 : ELSE 1479 : FG(1) = (XKISOI(ICAS-4)+XHH2I*(EPSI(ICAS-4)-EPSII(ICAS-4))) 1480 : & *RESIST(ICAS) 1480 : CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,FFF(ICAS)) 1481 : R(1) = + FFF(ICAS) 1482 : & - ISGNTC*RESIST(ICAS) 1483 : & * (XKISO(ICAS-4) - XKISOI(ICAS-4) 1484 : & -(EPSI(ICAS-4) - EPSII(ICAS-4))*XHH2I) 1485 : IF (ABS(EPSI(ICAS-4) - EPSII(ICAS-4)).LT.EPSILO2) THEN 1486 : XHH2I=XHH2 1487 : ELSE 1488 : XHH2I = (XKISO(ICAS-4) - XKISOI(ICAS-4))/ 1489 : & (EPSI(ICAS-4) - EPSII(ICAS-4)) 1490 : ENDIF 1491 : EPSII(ICAS-4) = EPSI(ICAS-4) 1492 : XKISOI(ICAS-4) = XKISO(ICAS-4) 1493 : ENDIF 1494 : C 1495 : IF (ICASB.LE.4) THEN 1495 : CALL CRITPE (SIGTP(IHARDB),SIGHP(IHARDB),RESIST(ICASB), 1496 : & ISGNTCB,FFF(ICASB)) 1497 : R(2)= + FFF(ICASB) 1498 : ELSE 1499 : FG(1) = (XKISOI(ICASB-4)+XHH2IB*(EPSI(ICASB-4) - 1500 : & EPSII(ICASB-4)))*RESIST(ICASB) 1500 : CALL CRITPE (SIGTP(IHARDB),XZER,FG(1),ISGNTCB,FFF(ICASB)) 1501 : R(2) = + FFF(ICASB) 1502 : & - ISGNTCB*RESIST(ICASB) 1503 : & * (XKISO(ICASB-4) - XKISOI(ICASB-4) 1504 : & -(EPSI(ICASB-4) - EPSII(ICASB-4))*XHH2IB) 1505 : IF (ABS(EPSI(ICASB-4) - EPSII(ICASB-4)).LT.EPSILO2) THEN 1506 : XHH2IB=XHH2B 1507 : ELSE 1508 : XHH2IB = (XKISO(ICASB-4) - XKISOI(ICASB-4))/ 1509 : & (EPSI(ICASB-4) - EPSII(ICASB-4)) 1510 : ENDIF 1511 : XKISOI(ICASB-4) = XKISO(ICASB-4) 1512 : EPSII(ICASB-4) = EPSI(ICASB-4) 1513 : ENDIF 1514 : C 1515 : C Test de convergence 1516 : C 1517 : IF ((ABS(FFF(ICAS)).LE.EPSIL(ICAS)) 1518 : &.AND.(ABS(FFF(ICASB)).LE.EPSIL(ICASB)).AND. 1519 : &(ABS(R(1)).LE.EPSIL(ICAS)).AND.(ABS(R(2)).LE.EPSIL(ICASB))) THEN 1520 : GOTO 4020 1521 : ENDIF 1522 : ENDDO 1523 : C 1524 : C Pas de convergence 1525 : C 1526 : SEGSUP,QUASIN 1527 : GOTO 6000 1528 : C 1529 : 4020 CONTINUE 1530 : SEGSUP,QUASIN 1531 : C 1532 : IF ((GAMBDA(ICAS).LT.EPSILO2).OR. 1533 : &(GAMBDA(ICASB).LT.EPSILO2)) THEN 1534 : 4030 CONTINUE 1535 : IF (NPASS.LE.5) THEN 1536 : NPASS = NPASS + 1 1537 : ELSE 1538 : GOTO 6000 1539 : ENDIF 1540 : IF ((GAMBDA(ICAS).LT.EPSILO2).AND. 1541 : &(GAMBDA(ICASB).LT.EPSILO2)) THEN 1542 : C Ce cas n'arrive que si les normales ont ete mal estimes: 1543 : C (increment elastique trop grand) --> on bissecte 1544 : GOTO 6000 1545 : ELSE 1546 : IF (GAMBDA(ICAS).LT.EPSILO2) THEN 1547 : ICAS = ICASB 1548 : IHARD = IHARDB 1549 : ISGNTC = ISGNTCB 1550 : ELSE 1551 : CONTINUE 1552 : ENDIF 1553 : ENDIF 1554 : SIGHP(1) = SIGHP0(1) 1555 : SIGHP(2) = SIGHP0(2) 1556 : SIGT(1) = SIGI(1) + DSIGI(1) 1557 : SIGT(2) = SIGI(2) + DSIGI(2) 1558 : SIGT(4) = SIGI(4) + DSIGI(4) 1559 : GOTO 1000 1560 : ENDIF 1561 : C On teste les mecanismes de la grande surface 1562 : C Si un des criteres est viole (et donc s'il n'y a pas contact) 1563 : C il faut trouver le point de contact 1564 : C 1564 : CALL CONPRI ( SIGT ,CPHI0,SPHI0,SIGTP,CPHI,SPHI) 1565 : C 1566 : NCON = 0 1567 : FINT1 = 0. 1568 : FINT2 = 0. 1569 : C 1570 : XFFFS = XZER 1571 : XFFFSB = XZER 1572 : IF (ICAS.LE.4) THEN 1573 : IF (ICAS.LE.2) THEN 1574 : FG(1) = XKISO(1)*RESIST(5) 1575 : ELSE 1576 : FG(1) = XKISO(2)*RESIST(6) 1577 : ENDIF 1577 : CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,XFFFS) 1578 : IF (((XFFFS.GE.EPSIL(5)).AND.(ICAS.LE.2)).OR. 1579 : & ((XFFFS.GE.EPSIL(6)).AND.(ICAS.GE.3))) THEN 1580 : NCON = NCON +1 1581 : ELSE 1582 : IF (((ICAS.LE.2).AND.(ABS(XFFFS).LT.EPSIL(5))).OR. 1583 : &((ICAS.GE.3).AND.(ABS(XFFFS).LT.EPSIL(6)))) THEN 1584 : KONTAC(ICAS) = 1 1585 : ELSE 1586 : CONTINUE 1587 : ENDIF 1588 : ENDIF 1589 : ENDIF 1590 : C 1591 : IF (ICASB.LE.4) THEN 1592 : IF (ICASB.LE.2) THEN 1593 : FG(1) = XKISO(1)*RESIST(5) 1594 : ELSE 1595 : FG(1) = XKISO(2)*RESIST(6) 1596 : ENDIF 1596 : CALL CRITPE (SIGTP(IHARDB),XZER,FG(1),ISGNTCB,XFFFSB) 1597 : IF (((XFFFSB.GE.EPSIL(5)).AND.(ICASB.LE.2)).OR. 1598 : & ((XFFFSB.GE.EPSIL(6)).AND.(ICASB.GE.3))) THEN 1599 : NCON = NCON +1 1600 : ELSE 1601 : IF (((ICASB.LE.2).AND.(ABS(XFFFSB).LT.EPSIL(5))).OR. 1602 : &((ICASB.GT.3).AND.(ABS(XFFFSB).LT.EPSIL(6)))) THEN 1603 : KONTAC(ICASB) = 1 1604 : ELSE 1605 : CONTINUE 1606 : ENDIF 1607 : ENDIF 1608 : ENDIF 1609 : C 1610 : IF (NCON.EQ.1) THEN 1611 : IF (((XFFFS.GE.EPSIL(5)).AND.(ICAS.LE.2)).OR. 1612 : & ((XFFFS.GE.EPSIL(6)).AND.(ICAS.GE.3))) THEN 1613 : GOTO 4040 1614 : ELSE 1615 : ICASI = ICAS 1616 : ISGNTCI = ISGNTC 1617 : IHARDI = IHARD 1618 : ICAS = ICASB 1619 : ISGNTC = ISGNTCB 1620 : IHARD = IHARDB 1621 : ICASB = ICASI 1622 : ISGNTCB = ISGNTCI 1623 : IHARDB = IHARDI 1624 : GOTO 4040 1625 : ENDIF 1626 : ELSE 1627 : IF (NCON.EQ.2) THEN 1628 : GOTO 4040 1629 : ELSE 1630 : CONTINUE 1631 : ENDIF 1632 : CONTINUE 1633 : ENDIF 1634 : C 1635 : C Regles de suivi avant de sortir normalement 1636 : C Direction de l'ecoulement 1637 : IF (ICAS.GE.5) THEN 1638 : SIGHP(IHARD) = XKISO(ICAS-4)*RESIST(ICAS) 1639 : & -RESIST(2*ICAS-10+IHARD) 1640 : ENDIF 1641 : IF (ICASB.GE.5) THEN 1642 : SIGHP(IHARDB) = XKISO(ICASB-4)*RESIST(ICASB) 1643 : & -RESIST(2*ICASB-10+IHARDB) 1644 : ENDIF 1645 : C 1646 : C Mis a jour des indicateurs de contact 1647 : C 1648 : IF ((XKISO(1)*RESIST(5)-XKISO(2)*RESIST(6)).GT. 1649 : &(RESIST(1)-RESIST(3))) THEN 1650 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) KONTAC(ICAS+2)=0 1651 : IF ((ICAS.EQ.3).OR.(ICAS.EQ.4)) KONTAC(ICAS-2)=0 1652 : IF ((ICASB.EQ.1).OR.(ICASB.EQ.2)) KONTAC(ICASB+2)=0 1653 : IF ((ICASB.EQ.3).OR.(ICASB.EQ.4)) KONTAC(ICASB-2)=0 1654 : ELSE 1655 : KONTAC(1) = 1 1656 : KONTAC(2) = 1 1657 : KONTAC(3) = 1 1658 : KONTAC(4) = 1 1659 : ENDIF 1660 : C 1661 : GOTO 9999 1662 : C 1663 : C On va au contact 1664 : 4040 CONTINUE 1665 : SIGHP(1) = SIGHP0(1) 1666 : SIGHP(2) = SIGHP0(2) 1667 : SIGT(1) = SIGI(1) + DSIGI(1) 1668 : SIGT(2) = SIGI(2) + DSIGI(2) 1669 : SIGT(4) = SIGI(4) + DSIGI(4) 1670 : EPSI(1) = EPSI0(1) 1671 : EPSI(2) = EPSI0(2) 1672 : GOTO 5000 1673 : C================================================================ 1674 : C CAS 5 1675 : C Deux mecanismes avec 1676 : C Entree en contact de 2 mecanismes 1677 : C================================================================ 1678 : 5000 CONTINUE 1679 : C 1679 : CALL CONPRI ( SIGT , CPHI0,SPHI0,SIGTP,CPHI,SPHI) 1680 : C 1681 : C ISGN2 et ISGN2B 1682 : IF (IHARD.EQ.1) THEN 1683 : IF (SIGTP(1).GE.SIGTP(2)) THEN 1684 : ISGN2 = 1 1685 : ELSE 1686 : ISGN2 = -1 1687 : ENDIF 1688 : ELSE 1689 : IF (IHARD.EQ.2) THEN 1690 : IF (SIGTP(1).GE.SIGTP(2)) THEN 1691 : ISGN2 = -1 1692 : ELSE 1693 : ISGN2 = 1 1694 : ENDIF 1695 : ENDIF 1696 : ENDIF 1697 : C 1698 : IF (IHARDB.EQ.1) THEN 1699 : IF (SIGTP(1).GE.SIGTP(2)) THEN 1700 : ISGN2B = 1 1701 : ELSE 1702 : ISGN2B = -1 1703 : ENDIF 1704 : ELSE 1705 : IF (IHARDB.EQ.2) THEN 1706 : IF (SIGTP(1).GE.SIGTP(2)) THEN 1707 : ISGN2B = -1 1708 : ELSE 1709 : ISGN2B = 1 1710 : ENDIF 1711 : ENDIF 1712 : ENDIF 1713 : C 1714 : 5010 CONTINUE 1715 : C 1716 : C Definition du segment 1717 : C 1718 : ITM = 30 1719 : MN = 3 1720 : SEGINI,QUASIN 1721 : IT = -1 1721 : CALL ZERO(D,1,MN) 1722 : C XKISO et XHH2 1723 : IF (ICASB.LE.4) THEN 1724 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN 1724 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT, 1725 : &XKISO(1),XHH2,KERRE) 1725 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC, 1726 : &XKISO(2),DUMM,KERRE) 1727 : ELSE 1727 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT, 1728 : &XKISO(1),DUMM,KERRE) 1728 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC, 1729 : &XKISO(2),XHH2,KERRE) 1730 : ENDIF 1731 : ELSE 1732 : IF (ICASB.EQ.5) THEN 1733 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN 1733 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1734 : & ,XHH2,KERRE) 1735 : XHH2B=XHH2 1735 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1736 : & ,DUMM,KERRE) 1737 : ELSE 1737 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1738 : & ,XHH2B,KERRE) 1738 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1739 : & ,XHH2,KERRE) 1740 : ENDIF 1741 : ELSE 1742 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN 1742 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1743 : & ,XHH2,KERRE) 1743 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1744 : & ,XHH2B,KERRE) 1745 : ELSE 1745 : CALL VALEUR (EPSI0(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1746 : & ,DUMM,KERRE) 1746 : CALL VALEUR (EPSI0(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1747 : & ,XHH2,KERRE) 1748 : XHH2B = XHH2 1749 : ENDIF 1750 : ENDIF 1751 : ENDIF 1752 : C 1753 : XKISO0(1)=XKISO(1) 1754 : EPSI(1)=EPSI0(1) 1755 : XKISO0(2)=XKISO(2) 1756 : EPSI(2)=EPSI0(2) 1757 : XHH2I = XHH2 1758 : XHH2IB = XHH2B 1759 : XKISOI(1)=XKISO(1) 1760 : XKISOI(2)=XKISO(2) 1761 : EPSII(1)=EPSI0(1) 1762 : EPSII(2)=EPSI0(2) 1763 : C 1764 : DO 5011,IE1=1,6 1765 : FFF(IE1) = XZER 1766 : 5011 CONTINUE 1767 : C 1767 : CALL CRITPE (SIGTP(IHARD),SIGHP0(IHARD),RESIST(ICAS), 1768 : & ISGNTC,FFF(ICAS)) 1769 : C 1770 : IF (ICASB.LE.4) THEN 1770 : CALL CRITPE (SIGTP(IHARDB),SIGHP0(IHARDB),RESIST(ICASB), 1771 : & ISGNTCB,FFF(ICASB)) 1772 : ELSE 1773 : FG(1) = XKISOI(ICASB -4)*RESIST(ICASB) 1773 : CALL CRITPE (SIGTP(IHARDB), XZER, FG(1),ISGNTCB,FFF(ICASB)) 1774 : ENDIF 1775 : C 1776 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN 1777 : FG(1) = XKISO(1)*RESIST(5) 1777 : CALL CRITPE (SIGTP(IHARD), XZER, FG(1), ISGNTC,XFFFS) 1778 : ELSE 1779 : FG(1) = XKISO(2)*RESIST(6) 1779 : CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,XFFFS) 1780 : ENDIF 1781 : C 1781 : CALL NORMBL(SIGT,RESIST(ICAS),ISGNTC,ISGN2,1,XNOR1) 1781 : CALL NORMBL(SIGT,RESIST(ICASB),ISGNTCB,ISGN2B,1,XNOR2) 1782 : C 1783 : C Jacobien 1784 : C 1785 : XJ00(1,1) = -XXCCYY(XNOR1, XNOR1, YOUN, XNU) - XHH1 1786 : XJ00(1,2) = -XXCCYY(XNOR1, XNOR2, YOUN, XNU) 1787 : XJ00(1,3) = -XXYY(XNOR1 , DSIGI) 1788 : XJ00(2,1) = -XXCCYY(XNOR2, XNOR1, YOUN, XNU) 1789 : XJ00(2,2) = -XXCCYY(XNOR2, XNOR2, YOUN, XNU) 1790 : XJ00(2,3) = -XXYY(XNOR2,DSIGI) 1791 : XJ00(3,1) = -XXCCYY(XNOR1,XNOR1,YOUN,XNU) 1792 : XJ00(3,2) = -XXCCYY(XNOR1,XNOR2,YOUN,XNU) 1793 : XJ00(3,3) = -XXYY(XNOR1,DSIGI) 1794 : C 1795 : IF ((ICAS.EQ.3).OR.(ICAS.EQ.4)) THEN 1796 : XJ00(3,1)=XJ00(3,1)+RESIST(6)*XHH2*DEGRAD*ISGNTC*RESIST(ICAS) 1797 : ENDIF 1798 : C 1799 : IF (ICASB.LE.4) THEN 1800 : XJ00(2,2) = XJ00(2,2) - XHH1 1801 : IF ((ICAS.EQ.3).OR.(ICAS.EQ.4)) THEN 1802 : XJ00(3,2)=XJ00(3,2)+RESIST(6)*XHH2 1803 : &*DEGRAD*ISGNTCB*RESIST(ICASB) 1804 : ENDIF 1805 : ELSE 1806 : XJ00(2,2) = XJ00(2,2) - RESIST(ICASB)*XHH2B*ISGNTCB 1807 : ENDIF 1808 : C 1809 : C 1810 : R(1) = FFF(ICAS) 1811 : R(2) = FFF(ICASB) 1812 : R(3) = XFFFS 1813 : C 1814 : SPLITT = XZER 1815 : GAMBDA(1) = XZER 1816 : GAMBDA(2) = XZER 1817 : GAMBDA(3) = XZER 1818 : GAMBDA(4) = XZER 1819 : GAMBDA(5) = XZER 1820 : GAMBDA(6) = XZER 1821 : C 1822 : C Inverse du jacobien 1823 : C 1824 : XH0(1,1) = XJ00(1,1) 1825 : XH0(1,2) = XJ00(1,2) 1826 : XH0(1,3) = XJ00(1,3) 1827 : XH0(2,1) = XJ00(2,1) 1828 : XH0(2,2) = XJ00(2,2) 1829 : XH0(2,3) = XJ00(2,3) 1830 : XH0(3,1) = XJ00(3,1) 1831 : XH0(3,2) = XJ00(3,2) 1832 : XH0(3,3) = XJ00(3,3) 1832 : CALL INVALM (XH0, MN , MN , IRD, 1.D-12) 1833 : IF (IRD.NE.0) THEN 1834 : SEGSUP,QUASIN 1835 : GOTO 6000 1836 : ENDIF 1837 : C 1838 : C On rentre dans les iterations internes 1839 : C 1840 : DO I=0,ITM 1841 : C 1842 : C Appel de Broyden 1843 : C 1843 : CALL BROYDE (QUASIN) 1844 : C 1845 : GAMBDA(ICAS) = D(1) 1846 : GAMBDA(ICASB) = D(2) 1847 : SPLITT = D(3) 1848 : C 1849 : C Calcul du phi et des termes de la matrice A et A-1 1850 : C 1851 : SITPRO(1) = SIGI(1) + (UN-SPLITT)*DSIGI(1) 1852 : & - UNDEMI*(GAMBDA(1) + GAMBDA(2) + GAMBDA(5))*CPI 1853 : & + UNDEMI*(GAMBDA(3) + GAMBDA(4) + GAMBDA(6))*CPI 1854 : SITPRO(2) = SIGI(2) + (UN-SPLITT)*DSIGI(2) 1855 : & - UNDEMI*(GAMBDA(1) + GAMBDA(2) + GAMBDA(5))*CPI 1856 : & + UNDEMI*(GAMBDA(3) + GAMBDA(4) + GAMBDA(6))*CPI 1857 : SITPRO(4) = SIGI(4) + (UN-SPLITT)*DSIGI(4) 1858 : C 1859 : C PHI et AINV 1860 : C 1861 : SIGHP(1) = SIGHP0(1) + XHH1*(GAMBDA(1)-GAMBDA(3)) 1862 : SIGHP(2) = SIGHP0(2) + XHH1*(GAMBDA(2)-GAMBDA(4)) 1863 : EPSI(1) = EPSI0(1) + GAMBDA(5) 1864 : WORK = ISGNTC*RESIST(ICAS)*GAMBDA(ICAS) 1865 : IF (ICASB.LE.4) THEN 1866 : WORK = WORK + ISGNTCB*RESIST(ICASB)*GAMBDA(ICASB) 1867 : ENDIF 1868 : EPSI(2)=EPSI0(2)+ GAMBDA(6) + DEGRAD*WORK 1869 : C 1870 : IF (ICASB.LE.4) THEN 1871 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN 1871 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT, 1872 : &XKISO(1),XHH2,KERRE) 1872 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC, 1873 : &XKISO(2),DUMM,KERRE) 1874 : ELSE 1874 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT, 1875 : &XKISO(1),DUMM,KERRE) 1875 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC, 1876 : &XKISO(2),XHH2,KERRE) 1877 : ENDIF 1878 : ELSE 1879 : IF (ICASB.EQ.5) THEN 1880 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN 1880 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1881 : & ,XHH2,KERRE) 1882 : XHH2B=XHH2 1882 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1883 : & ,DUMM,KERRE) 1884 : ELSE 1884 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1885 : & ,XHH2B,KERRE) 1885 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1886 : & ,XHH2,KERRE) 1887 : ENDIF 1888 : ELSE 1889 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN 1889 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1890 : & ,XHH2,KERRE) 1890 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1891 : & ,XHH2B,KERRE) 1892 : ELSE 1892 : CALL VALEUR (EPSI(1),TRAC(IPT),NCURVT,XLCAT,XKISO(1) 1893 : & ,DUMM,KERRE) 1893 : CALL VALEUR (EPSI(2),TRAC(IPC),NCURVC,XLCAC,XKISO(2) 1894 : & ,XHH2,KERRE) 1895 : XHH2B = XHH2 1896 : ENDIF 1897 : ENDIF 1898 : ENDIF 1899 : C 1900 : C Calcul des phi 1901 : C 1902 : PHI1=ISGNTC*(-UNDEMI*(SITPRO(1) + SITPRO(2)) 1903 : & + SIGHP(IHARD) + RESIST(ICAS)) 1904 : C 1905 : IF (ICASB.LE.4) THEN 1906 : PHI2=ISGNTCB*(-UNDEMI*(SITPRO(1) + SITPRO(2)) 1907 : & + SIGHP(IHARDB)+ RESIST(ICASB)) 1908 : ELSE 1909 : PHI2=ISGNTCB*(-UNDEMI*(SITPRO(1)+SITPRO(2)) 1910 : & + (XKISOI(ICASB-4)+XHH2IB*(EPSI(ICASB-4)-EPSII(ICASB-4))) 1911 : & *RESIST(ICASB)) 1912 : ENDIF 1913 : C 1914 : C Test sur phi1 et phi2 1915 : C 1916 : IF ((ABS(PHI2)).GT.(ABS(EPSILO*RESIST(ICASB)))) THEN 1917 : SOMLAM = GAMBDA(ICAS) + GAMBDA(ICASB)*PHI1/PHI2 1918 : PHI = PHI1 1919 : ELSE 1920 : IF ((ABS(PHI1)).GT.(ABS(EPSILO*RESIST(ICAS)))) THEN 1921 : SOMLAM = GAMBDA(ICASB) + GAMBDA(ICAS)*PHI2/PHI1 1922 : PHI = PHI2 1923 : ELSE 1924 : SOMLAM = GAMBDA(ICASB) + GAMBDA(ICAS) 1925 : PHI = PHI1 1926 : ENDIF 1927 : ENDIF 1928 : C 1929 : AINV(1) = (DEUX*PHI+GGG*SOMLAM)/(DEUX*PHI+DEUX*GGG*SOMLAM) 1930 : AINV(2) = (GGG*SOMLAM)/(DEUX*PHI + DEUX*GGG*SOMLAM) 1931 : AINV(3) = PHI/(PHI + GGG*SOMLAM) 1932 : C 1933 : C Calcul des contraintes a l'aide de AINV 1934 : C 1935 : SIGT(1) = AINV(1)*SITPRO(1)+AINV(2)*SITPRO(2) 1936 : SIGT(2) = AINV(2)*SITPRO(1)+AINV(1)*SITPRO(2) 1937 : SIGT(4) = AINV(3)*SITPRO(4) 1938 : C 1939 : C Nouvelles contraintes principales 1940 : C 1940 : CALL CONPRI ( SIGT , CPHI0,SPHI0,SIGTP,CPHI,SPHI) 1941 : C 1941 : CALL CRITPE (SIGTP(IHARD),SIGHP(IHARD),RESIST(ICAS), 1942 : & ISGNTC,FFF(ICAS)) 1943 : R(1)= + FFF(ICAS) 1944 : C 1945 : IF (ICASB.LE.4) THEN 1945 : CALL CRITPE (SIGTP(IHARDB),SIGHP(IHARDB),RESIST(ICASB), 1946 : & ISGNTCB,FFF(ICASB)) 1947 : R(2)= + FFF(ICASB) 1948 : ELSE 1949 : FG(1) = (XKISOI(ICASB -4)+XHH2IB*(EPSI(ICASB-4) 1950 : & - EPSII(ICASB-4)))*RESIST(ICASB) 1950 : CALL CRITPE (SIGTP(IHARDB), XZER, FG(1),ISGNTCB,FFF(ICASB)) 1951 : R(2) = + FFF(ICASB) 1952 : & - ISGNTCB*RESIST(ICASB) 1953 : & * (XKISO(ICASB-4) - XKISOI(ICASB-4) 1954 : & -(EPSI(ICASB-4) - EPSII(ICASB-4))*XHH2IB) 1955 : IF (ABS(EPSI(ICASB-4) - EPSII(ICASB-4)).LT.EPSILO2) THEN 1956 : XHH2IB=XHH2B 1957 : ELSE 1958 : XHH2IB = (XKISO(ICASB-4) - XKISOI(ICASB-4))/ 1959 : & (EPSI(ICASB-4) - EPSII(ICASB-4)) 1960 : ENDIF 1961 : ENDIF 1962 : C 1963 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN 1964 : FG(1) = XKISO(1)*RESIST(5) 1964 : CALL CRITPE (SIGTP(IHARD), XZER, FG(1), ISGNTC,XFFFS) 1965 : R(3) = XFFFS 1966 : ELSE 1967 : FG(1) = (XKISOI(2)+XHH2I*(EPSI(2)-EPSII(2)))*RESIST(6) 1967 : CALL CRITPE (SIGTP(IHARD),XZER,FG(1),ISGNTC,XFFFS) 1968 : R(3) = XFFFS + RESIST(6)* 1969 : & (XKISO(2) - XKISOI(2)-(EPSI(2) - EPSII(2))*XHH2I) 1970 : IF (ABS(EPSI(2) - EPSII(2)).LT.EPSILO2) THEN 1971 : XHH2I=XHH2 1972 : ELSE 1973 : XHH2I = (XKISO(2) - XKISOI(2))/ 1974 : & (EPSI(2) - EPSII(2)) 1975 : ENDIF 1976 : ENDIF 1977 : XKISOI(1) = XKISO(1) 1978 : EPSII(1) = EPSI(1) 1979 : XKISOI(2) = XKISO(2) 1980 : EPSII(2) = EPSI(2) 1981 : C 1982 : C Test de convergence 1983 : C 1984 : IF (ICAS.LE.2) THEN 1985 : IF ((ABS(FFF(ICAS)).LT.EPSIL(ICAS)).AND. 1986 : & (ABS(R(1)).LT.EPSIL(ICAS)).AND. 1987 : & (ABS(FFF(ICASB)).LT.EPSIL(ICASB)).AND. 1988 : & (ABS(R(2)).LT.EPSIL(ICASB)).AND. 1989 : & (ABS(XFFFS).LT.EPSIL(5)).AND. 1990 : & (ABS(R(3)).LT.EPSIL(5))) THEN 1991 : GOTO 5020 1992 : ENDIF 1993 : ELSE 1994 : IF ((ABS(FFF(ICAS)).LT.EPSIL(ICAS)).AND. 1995 : & (ABS(R(1)).LT.EPSIL(ICAS)).AND. 1996 : & (ABS(FFF(ICASB)).LT.EPSIL(ICASB)).AND. 1997 : & (ABS(R(2)).LT.EPSIL(ICASB)).AND. 1998 : & (ABS(XFFFS).LT.EPSIL(6)).AND. 1999 : & (ABS(R(3)).LT.EPSIL(6))) THEN 2000 : GOTO 5020 2001 : ENDIF 2002 : ENDIF 2003 : ENDDO 2004 : C 2005 : C Pas de convergence 2006 : C 2007 : SEGSUP,QUASIN 2008 : GOTO 6000 2009 : C 2010 : 5020 CONTINUE 2011 : SEGSUP,QUASIN 2012 : C 2013 : C 2014 : IF (((SPLITT-1.).LE.EPSILO).AND.(SPLITT.GE.(-1.*EPSILO)).AND. 2015 : &(GAMBDA(ICAS).GE.EPSILO2) 2016 : &.AND.(GAMBDA(ICASB).GE.EPSILO2)) THEN 2017 : C 2018 : C On a les contraintes, les variables d'ecrouissage cinemat. et tgphi 2019 : C Mis a jour des variables d'ecrouissage isotrope ou regles de suivi 2020 : C 2021 : 2022 : IF (NCON.EQ.2) THEN 2023 : IF (ICASB.LE.4) THEN 2024 : C 2025 : IF (ICASB.LE.2) THEN 2026 : FG(1) = XKISO(1)*RESIST(5) 2027 : ELSE 2028 : FG(1) = XKISO(2)*RESIST(6) 2029 : ENDIF 2029 : CALL CRITPE (SIGTP(IHARDB),XZER,FG(1),ISGNTCB,XFFFSB) 2030 : C 2031 : C On regarde si on ne s'est pas trompe d'ordre 2032 : C 2033 : IF (((XFFFSB.GE.EPSIL(5)).AND.(ICASB.LE.2)).OR. 2034 : & ((XFFFSB.GE.EPSIL(6)).AND.(ICASB.GE.3))) THEN 2035 : ICASI = ICAS 2036 : ISGNTCI = ISGNTC 2037 : IHARDI = IHARD 2038 : ICAS = ICASB 2039 : ISGNTC = ISGNTCB 2040 : IHARD = IHARDB 2041 : ICASB = ICASI 2042 : ISGNTCB = ISGNTCI 2043 : IHARDB = IHARDI 2044 : GOTO 4040 2045 : ELSE 2046 : IF ((ICASB.LE.2).AND.(ABS(XFFFSB).LT.EPSIL(5))) THEN 2047 : KONTAC(ICASB) = 1 2048 : ICASB=5 2049 : ENDIF 2050 : IF (((ICASB.EQ.3).OR.(ICASB.EQ.4)) 2051 : & .AND.(ABS(XFFFSB).LT.EPSIL(6))) THEN 2052 : KONTAC(ICASB) = 1 2053 : ICASB=6 2054 : ENDIF 2055 : ENDIF 2056 : C 2057 : ELSE 2058 : CONTINUE 2059 : ENDIF 2060 : ELSE 2061 : CONTINUE 2062 : ENDIF 2063 : C 2064 : C Le contact est realise 2065 : C 2066 : KONTAC(ICAS) = 1 2067 : IF ((XKISO(1)*RESIST(5)-XKISO(2)*RESIST(6)).GT. 2068 : &(RESIST(1)-RESIST(3))) THEN 2069 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) KONTAC(ICAS+2)=0 2070 : IF ((ICAS.EQ.3).OR.(ICAS.EQ.4)) KONTAC(ICAS-2)=0 2071 : IF ((ICASB.EQ.1).OR.(ICASB.EQ.2)) KONTAC(ICASB+2)=0 2072 : IF ((ICASB.EQ.3).OR.(ICASB.EQ.4)) KONTAC(ICASB-2)=0 2073 : ELSE 2074 : KONTAC(1) = 1 2075 : KONTAC(2) = 1 2076 : KONTAC(3) = 1 2077 : KONTAC(4) = 1 2078 : ENDIF 2079 : C 2080 : SIGI(1) = SIGT(1) 2081 : SIGI(2) = SIGT(2) 2082 : SIGI(4) = SIGT(4) 2083 : DSIGI(1) = DSIGI(1)*SPLITT 2084 : DSIGI(2) = DSIGI(2)*SPLITT 2085 : DSIGI(4) = DSIGI(4)*SPLITT 2086 : SIGT(1) = SIGI(1) + DSIGI(1) 2087 : SIGT(2) = SIGI(2) + DSIGI(2) 2088 : SIGT(4) = SIGI(4) + DSIGI(4) 2089 : SIGHP0(1) = SIGHP(1) 2090 : SIGHP0(2) = SIGHP(2) 2091 : EPSI0(1) = EPSI(1) 2092 : EPSI0(2) = EPSI(2) 2093 : NPASS2 = 0 2094 : CPHI0 = CPHI 2095 : SPHI0 = SPHI 2096 : IF ((ICAS.EQ.1).OR.(ICAS.EQ.2)) THEN 2097 : ICAS = 5 2098 : ELSE 2099 : ICAS = 6 2100 : ENDIF 2101 : IF (ICASB.LE.4) THEN 2102 : GOTO 4000 2103 : ELSE 2104 : IF (ICASB.EQ.ICAS) THEN 2105 : C On passe de 2 mecanismes a 1 mecanisme 2106 : GOTO 1000 2107 : ELSE 2108 : GOTO 4000 2109 : ENDIF 2110 : ENDIF 2111 : C 2112 : C 2113 : ELSE 2114 : 5040 CONTINUE 2115 : IF ((GAMBDA(ICASB).LT.EPSILO2).AND.(NPASS.LE.3)) THEN 2116 : SIGHP(1) = SIGHP0(1) 2117 : SIGHP(2) = SIGHP0(2) 2118 : SIGT(1) = SIGI(1) + DSIGI(1) 2119 : SIGT(2) = SIGI(2) + DSIGI(2) 2120 : SIGT(4) = SIGI(4) + DSIGI(4) 2121 : IF (NPASS.LT.5) THEN 2122 : NPASS = NPASS + 1 2123 : GOTO 3000 2124 : ELSE 2125 : GOTO 6000 2126 : ENDIF 2127 : ELSE 2128 : IF ((GAMBDA(ICAS).LT.EPSILO2).AND.(NPASS2.EQ.0)) THEN 2129 : NPASS2 = 1 2130 : SIGHP(1) = SIGHP0(1) 2131 : SIGHP(2) = SIGHP0(2) 2132 : SIGT(1) = SIGI(1) + DSIGI(1) 2133 : SIGT(2) = SIGI(2) + DSIGI(2) 2134 : SIGT(4) = SIGI(4) + DSIGI(4) 2135 : ICAS = ICASB 2136 : IHARD = IHARDB 2137 : ISGNTC = ISGNTCB 2138 : IF (NPASS.LT.5) THEN 2139 : NPASS = NPASS + 1 2140 : GOTO 1000 2141 : ELSE 2142 : GOTO 6000 2143 : ENDIF 2144 : ELSE 2145 : GOTO 6000 2146 : ENDIF 2147 : ENDIF 2148 : ENDIF 2149 : C 2150 : C On bissecte 2151 : C 2152 : 6000 CONTINUE 2153 : NDICHO = NDICHO + 1 2154 : IF (NDICHO.LE.90) THEN 2155 : IDICHO = 1 2156 : DSIGIDI(1) = DSIGIDI(1) + UNDEMI*DSIGI(1) 2157 : DSIGIDI(2) = DSIGIDI(2) + UNDEMI*DSIGI(2) 2158 : DSIGIDI(4) = DSIGIDI(4) + UNDEMI*DSIGI(4) 2159 : DSIGI(1) = DSIGI(1)*UNDEMI 2160 : DSIGI(2) = DSIGI(2)*UNDEMI 2161 : DSIGI(4) = DSIGI(4)*UNDEMI 2162 : CPHI0 = CPHI00 2163 : SPHI0 = SPHI00 2164 : GOTO 10 2165 : ELSE 2166 : KERRE = 2 2167 : RETURN 2168 : ENDIF 2169 : C 2170 : C================================================================= 2171 : C MIS A JOUR DE TOUTES LES VARIABLES ET CONTRAINTES AVANT 2172 : C DE SORTIR 2173 : C================================================================= 2174 : 9999 CONTINUE 2175 : C Cas de la bissection 2176 : IF (IDICHO.EQ.1) THEN 2177 : IDICHO = 0 2178 : NDICHO = 0 2179 : NPASS = 0 2180 : DSIGI(1) = DSIGIDI(1) 2181 : DSIGI(2) = DSIGIDI(2) 2182 : DSIGI(4) = DSIGIDI(4) 2183 : SIGI(1) = SIGT(1) 2184 : SIGI(2) = SIGT(2) 2185 : SIGI(4) = SIGT(4) 2186 : DSIGIDI(1) = XZER 2187 : DSIGIDI(2) = XZER 2188 : DSIGIDI(4) = XZER 2189 : SIGHP0(1) = SIGHP(1) 2190 : SIGHP0(2) = SIGHP(2) 2191 : EPSI0(1) = EPSI(1) 2192 : EPSI0(2) = EPSI(2) 2193 : CPHI0 = CPHI 2194 : CPHI00 = CPHI0 2195 : SPHI0 = SPHI 2196 : SPHI00 = SPHI0 2197 : KONTA0(1) = KONTAC(1) 2198 : KONTA0(2) = KONTAC(2) 2199 : KONTA0(3) = KONTAC(3) 2200 : KONTA0(4) = KONTAC(4) 2201 : GOTO 10 2202 : ENDIF 2203 : C STRESS 2204 : SIGF(1) = SIGT(1) 2205 : SIGF(2) = SIGT(2) 2206 : SIGF(4) = SIGT(4) 2207 : SIGF(3) = XZER 2208 : C PLASTIC STRAIN 2209 : CINV(1) = UN/YOUN 2210 : CINV(2) = -XNU/YOUN 2211 : CINV(3) = UN/GGG 2212 : DEFP(1) =CINV(1)*(SIG0(1) + DSIGT(1) - SIGT(1)) 2213 : & +CINV(2)*(SIG0(2) + DSIGT(2) - SIGT(2)) 2214 : DEFP(2) =CINV(2)*(SIG0(1) + DSIGT(1) - SIGT(1)) 2215 : & +CINV(1)*(SIG0(2) + DSIGT(2) - SIGT(2)) 2216 : DEFP(4) =CINV(3)*(SIG0(4) + DSIGT(4) - SIGT(4)) 2217 : DEFP(3) = XZER 2218 : C 2219 : C Cas ou la grande surface est a l'interieur de la petite 2220 : C 2221 : IF ((XKISO(1)*RESIST(5)-XKISO(2)*RESIST(6)).LE. 2222 : &(RESIST(1)-RESIST(3))) THEN 2223 : KONTAC(1) = 1 2224 : KONTAC(2) = 1 2225 : KONTAC(3) = 1 2226 : KONTAC(4) = 1 2227 : ENDIF 2228 : VARF(1) = SIGHP(1) 2229 : VARF(2) = SIGHP(2) 2230 : VARF(3) = EPSI(1) 2231 : VARF(4) = EPSI(2) 2232 : VARF(5) = CPHI - 1.D0 2233 : VARF(6) = SPHI 2234 : VARF(7) = KONTAC(1) 2235 : VARF(8) = KONTAC(2) 2236 : VARF(9) = KONTAC(3) 2237 : VARF(10) = KONTAC(4) 2238 : VARF(11) = ICAS 2239 : VARF(12) = ICASB 2240 : VARF(13) = GAMBDA(ICAS) 2241 : VARF(14) = GAMBDA(ICASB) 2242 : C===================================================== 2243 : C FIN DE LA ROUTINE DU MODELE 2244 : C====================================================== 2245 : RETURN 2246 : END 2247 : 2248 : 2249 : 2250 : 2251 : 2252 : 2253 : 2254 :
© Cast3M 2003 - All rights reserved.
Disclaimer