1 : C CRACK SOURCE CHAT 05/01/12 22:27:45 5004 2 : SUBROUTINE CRACK(SIGMAT,SIGEL,DSIGP,R1,R2,R3,TETAQ,ITRAC,ITENS, 3 : .ITENRZ,ITENTE,ITETA,IRZ,SIGMA,DSIGMA,YUNG,XNU, 4 : .ALFAD2,DPELA2,PENTE2,IBAB,ICTD,KASTR, 5 : .PREC,RFSG,RFEP,RFPR,KERRE) 6 : C 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : -INC CCOPTIO 10 : C 11 : DIMENSION SIGEL(*),DSIGP(*) 12 : DIMENSION SIGMAT(6),WW1(3),SIGMA(6),DSIGP0(6) 13 : DIMENSION SIGTP(6),SIG0P(6),DSIGPP(6),DSIGMA(6),SIGEL0(6) 14 : C 15 : C INITIALISATION DES VARIABLES 16 : C 17 : CRIT= 0.D0 18 : GAMCIS=0.D0 19 : F1ST=0.D0 20 : F2ST=0.D0 21 : C 22 : C SI ON N A PAS LE DROIT D ECOULER SELON LE CRITERE DE LA TRACTION 23 : C 24 : IF(KASTR.NE.2) GO TO 99 25 : DO 199 I=1,6 26 : SIGMA(I)=SIGEL(I) 27 : DSIGMA(I)=DSIGP(I) 28 : 199 CONTINUE 29 : ICTD=1 30 : GO TO 333 31 : C 32 : C INITIALISATION 33 : C 34 : 99 R10=R1 35 : R20=R2 36 : R30=R3 37 : TETAQ0=TETAQ 38 : ITRAC0=ITRAC 39 : ITETA0=ITETA 40 : IRZ0=IRZ 41 : DO 100 I=1,6 42 : SIGEL0(I)=SIGEL(I) 43 : DSIGP0(I)=DSIGP(I) 44 : 100 CONTINUE 45 : UNIT=0.01745329252D0 46 : LUNE=1 47 : ICONCA=0 48 : ITER=0 49 : ICTD=0 50 : ZER=0.D0 51 : C 52 : 96 IND=0 53 : IND1=0 54 : IND2=0 55 : IND3=0 56 : JTRAC=ITRAC 57 : ITENS=0 58 : ITENRZ=0 59 : ITENTE=0 60 : SIMER=0.D0 61 : C 62 : C ROTATION DES AXES 63 : C 64 : 24 IF(ITER.LE.12) GO TO 48 65 : WRITE(IOIMP,1002) ITER 66 : KERRE=640 67 : RETURN 68 : C 69 : 48 ITER=ITER+1 70 : IF(IIMPI.EQ.9) WRITE(IOIMP,7001) (SIGEL(I),I=1,6) 71 : IF(IIMPI.EQ.9) WRITE(IOIMP,7006) (DSIGP(I),I=1,6) 72 : IF(IIMPI.EQ.9) 73 : . WRITE(IOIMP,7000) ITRAC,ITENRZ,ITENTE,ITETA,IRZ,ITER 74 : C 75 : IF(ITRAC.GT.0) GO TO 1 76 : WW1(1)=SIGEL(1) 77 : WW1(2)=SIGEL(2) 78 : WW1(3)=SIGEL(4) 78 : CALL DIAGOD(WW1) 79 : TETAQ=WW1(3) 80 : C 81 : 1 ANRUP=TETAQ*UNIT 82 : CO=COS(ANRUP) 83 : SII=SIN(ANRUP) 84 : CC=CO*CO 85 : SS=SII*SII 86 : CS=CO*SII 87 : C 88 : IF(ITRAC.GT.0) WW1(1)=ROTA(SIGEL,CC,SS,CS,1) 89 : IF(ITRAC.GT.0) WW1(2)=ROTA(SIGEL,CC,SS,CS,2) 90 : SIG0P(1)=WW1(1) 91 : SIG0P(2)=WW1(2) 92 : SIG0P(3)=SIGEL(3) 93 : SIG0P(4)=0.D0 94 : IF(ITRAC.GT.0) SIG0P(4)=ROTA(SIGEL,CC,SS,CS,3) 95 : SIG0P(5)=0.D0 96 : SIG0P(6)=0.D0 97 : C 98 : DSIGPP(1)=ROTA(DSIGP,CC,SS,CS,1) 99 : DSIGPP(2)=ROTA(DSIGP,CC,SS,CS,2) 100 : DSIGPP(3)=DSIGP(3) 101 : DSIGPP(4)=ROTA(DSIGP,CC,SS,CS,3) 102 : DSIGPP(5)=0.D0 103 : DSIGPP(6)=0.D0 104 : C 105 : IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 70 106 : DO 2 I=1,6 107 : SIGMA(I)=SIG0P(I) 108 : 2 CONTINUE 109 : IF(IIMPI.EQ.9) WRITE(IOIMP,7013) (SIGMA(I),I=1,6) 110 : C 111 : 70 DO 3 I=1,6 112 : SIGTP(I)=SIG0P(I)+DSIGPP(I) 113 : SIGMAT(I)=SIGEL(I)+DSIGP(I) 114 : 3 CONTINUE 115 : C 116 : IF(IIMPI.EQ.9) WRITE(IOIMP,7003) (SIG0P(I),I=1,6) 117 : IF(IIMPI.EQ.9) WRITE(IOIMP,7004) (DSIGPP(I),I=1,6) 118 : IF(IIMPI.EQ.9) WRITE(IOIMP,7005) (SIGTP(I),I=1,6) 119 : C 120 : CRIT1=SIGTP(1)-R1 121 : CRIT2=SIGTP(2)-R2 122 : CRIT3=SIGTP(3)-R3 123 : C 124 : IF(CRIT1.LE.0.D0.AND.CRIT2.LE.0.D0.AND.CRIT3.LE.0.D0) GO TO 4 125 : C 126 : UNMU=XNU/(1.D0-XNU) 127 : IF(CRIT1.GT.0.D0.AND.ITETA.NE.1.AND.IRZ.NE.2) IND1=1 128 : IF(CRIT2.GT.0.D0.AND.ITETA.NE.1.AND.IRZ.NE.1) IND2=2 129 : IF(CRIT3.GT.0.D0.AND.ITETA.NE.2) IND3=4 130 : IND=IND1+IND2+IND3 131 : IF(IIMPI.EQ.9) WRITE(IOIMP,7011) IND,IND1,IND2,IND3 132 : GO TO(11,12,14,13,15,16,17),IND 133 : WRITE(IOIMP,1000)IND 134 : KERRE=640 135 : RETURN 136 : C 137 : C*********************************************************************** 138 : C*************************** CAS D UNE SEULE FISSURE ******************* 139 : C*********************************************************************** 140 : C 141 : C FISSURE DANS LA DIRECTION (R) 142 : C 143 : 11 DSIGPP(1)=-SIG0P(1) 144 : DSIGPP(4)=-SIG0P(4) 145 : DSIGPP(6)=-SIG0P(6) 146 : DSIGPP(2)=DSIGPP(2)-SIGTP(1)*UNMU 147 : DSIGPP(3)=DSIGPP(3)-SIGTP(1)*UNMU 148 : SIMER=SIG0P(1)*UNMU 149 : R1=0.D0 150 : ITENRZ=1 151 : ITRAC=1 152 : IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 5 153 : SIGMA(1)=0.D0 154 : SIGMA(2)=SIGMA(2)-SIMER 155 : SIGMA(3)=SIGMA(3)-SIMER 156 : SIGMA(4)=0.D0 157 : SIGMA(6)=0.D0 158 : GO TO 5 159 : C 160 : C FISSURE DANS LA DIRECTION (Z) 161 : C 162 : 12 DSIGPP(2)=-SIG0P(2) 163 : DSIGPP(4)=-SIG0P(4) 164 : DSIGPP(5)=-SIG0P(5) 165 : DSIGPP(1)=DSIGPP(1)-SIGTP(2)*UNMU 166 : DSIGPP(3)=DSIGPP(3)-SIGTP(2)*UNMU 167 : SIMER=SIG0P(2)*UNMU 168 : R2=0.D0 169 : ITENRZ=1 170 : ITRAC=1 171 : IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 5 172 : SIGMA(1)=SIGMA(1)-SIMER 173 : SIGMA(2)=0.D0 174 : SIGMA(3)=SIGMA(3)-SIMER 175 : SIGMA(4)=0.D0 176 : SIGMA(5)=0.D0 177 : GO TO 5 178 : C 179 : C FISSURE DANS LA DIRECTION (@) 180 : C 181 : 13 DSIGPP(3)=-SIG0P(3) 182 : DSIGPP(5)=-SIG0P(5) 183 : DSIGPP(6)=-SIG0P(6) 184 : DSIGPP(1)=DSIGPP(1)-SIGTP(3)*UNMU 185 : DSIGPP(2)=DSIGPP(2)-SIGTP(3)*UNMU 186 : SIMER=SIG0P(3)*UNMU 187 : R3=0.D0 188 : ITENTE=1 189 : IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 5 190 : SIGMA(1)=SIGMA(1)-SIMER 191 : SIGMA(2)=SIGMA(2)-SIMER 192 : SIGMA(3)=0.D0 193 : SIGMA(5)=0.D0 194 : SIGMA(6)=0.D0 195 : GO TO 5 196 : C 197 : C*********************************************************************** 198 : C*************************** CAS DE DEUX FISSURES ********************** 199 : C*********************************************************************** 200 : C 201 : C DEUX FISSURES DANS LE PLAN (RZ) 202 : C 203 : 14 DSIGPP(1)=-SIG0P(1) 204 : DSIGPP(2)=-SIG0P(2) 205 : DSIGPP(3)=DSIGPP(3)-XNU*(SIGTP(1)+SIGTP(2)) 206 : SIMER=XNU*(SIG0P(1)+SIG0P(2)) 207 : R1=0.D0 208 : R2=0.D0 209 : ITENRZ=2 210 : ITRAC=1 211 : IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6 212 : SIGMA(1)=0.D0 213 : SIGMA(2)=0.D0 214 : SIGMA(3)=SIGMA(3)-SIMER 215 : SIGMA(4)=0.D0 216 : SIGMA(5)=0.D0 217 : SIGMA(6)=0.D0 218 : GO TO 6 219 : C 220 : C DEUX FISSURES DANS LE PLAN (R@) 221 : C 222 : 15 DSIGPP(1)=-SIG0P(1) 223 : DSIGPP(3)=-SIG0P(3) 224 : DSIGPP(2)=DSIGPP(2)-XNU*(SIGTP(1)+SIGTP(3)) 225 : SIMER=XNU*(SIG0P(1)+SIG0P(3)) 226 : R1=0.D0 227 : R3=0.D0 228 : ITENRZ=1 229 : ITENTE=1 230 : ITRAC=1 231 : IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6 232 : SIGMA(1)=0.D0 233 : SIGMA(2)=SIGMA(2)-SIMER 234 : SIGMA(3)=0.D0 235 : SIGMA(4)=0.D0 236 : SIGMA(5)=0.D0 237 : SIGMA(6)=0.D0 238 : GO TO 6 239 : C 240 : C DEUX FISSURES DANS LE PLAN (Z@) 241 : C 242 : 16 DSIGPP(2)=-SIG0P(2) 243 : DSIGPP(3)=-SIG0P(3) 244 : DSIGPP(1)=DSIGPP(1)-XNU*(SIGTP(2)+SIGTP(3)) 245 : SIMER=XNU*(SIG0P(2)+SIG0P(3)) 246 : R2=0.D0 247 : R3=0.D0 248 : ITENRZ=1 249 : ITENTE=1 250 : ITRAC=1 251 : IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6 252 : SIGMA(1)=SIGMA(1)-SIMER 253 : SIGMA(2)=0.D0 254 : SIGMA(3)=0.D0 255 : SIGMA(4)=0.D0 256 : SIGMA(5)=0.D0 257 : SIGMA(6)=0.D0 258 : GO TO 6 259 : C 260 : C*********************************************************************** 261 : C***************************** CAS DE TROIS FISSURES ******************* 262 : C*********************************************************************** 263 : C 264 : 17 DSIGPP(1)=-SIG0P(1) 265 : DSIGPP(2)=-SIG0P(2) 266 : DSIGPP(3)=-SIG0P(3) 267 : R1=0.D0 268 : R2=0.D0 269 : R3=0.D0 270 : ITENRZ=2 271 : ITENTE=1 272 : ITRAC=1 273 : IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6 274 : DO 8 I=1,6 275 : SIGMA(I)=0.D0 276 : 8 CONTINUE 277 : C 278 : 6 DSIGPP(4)=-SIG0P(4) 279 : DSIGPP(5)=-SIG0P(5) 280 : DSIGPP(6)=-SIG0P(6) 281 : C 282 : 5 DO 7 I=1,6 283 : SIGTP(I)=SIG0P(I)+DSIGPP(I) 284 : 7 CONTINUE 285 : C 286 : IF(IIMPI.EQ.9) WRITE(IOIMP,7005) (SIGTP(I),I=1,6) 287 : C 288 : C LE RETOUR DANS LES AXES 289 : C 290 : WW1(1)=SIGTP(1) 291 : WW1(2)=SIGTP(2) 292 : WW1(3)=SIGTP(4) 293 : C 293 : CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE) 294 : C 295 : SIGEL(3)=SIGTP(3) 296 : SIGEL(5)=0.D0 297 : SIGEL(6)=0.D0 298 : C 299 : IF(ITENRZ.EQ.0.AND.JTRAC.EQ.0) TETAQ=0.D0 300 : IF(IIMPI.EQ.9) 301 : . WRITE(IOIMP,7000) ITRAC,ITENRZ,ITENTE,ITETA,IRZ,ITER 302 : C 303 : IF(ITETA.EQ.3.AND.IRZ.EQ.1) ITETA=5 304 : IF(ITETA.EQ.3.AND.IRZ.EQ.2) ITETA=6 305 : IF(IIMPI.EQ.9) WRITE(IOIMP,7012) ITETA 306 : GO TO(21,22,23,33,25,26,23),ITETA 307 : WRITE(IOIMP,1001)ITETA 308 : KERRE=640 309 : RETURN 310 : C 311 : C*********************************************************************** 312 : C*************************** FISSURATION EN (@) PUIS EN (RZ) *********** 313 : C*********************************************************************** 314 : C 315 : 21 IF(ITRAC.GT.0) GO TO 18 316 : WW1(1)=SIGEL(1) 317 : WW1(2)=SIGEL(2) 318 : WW1(3)=SIGEL(4) 318 : CALL DIAGOD(WW1) 319 : F1ST=WW1(1) 320 : F2ST=WW1(2) 321 : 18 IF(ITRAC.GT.0) F1ST=ROTA(SIGEL,CC,SS,CS,1) 322 : IF(ITRAC.GT.0) F2ST=ROTA(SIGEL,CC,SS,CS,2) 323 : CRIT1=F1ST-R1 324 : CRIT2=F2ST-R2 325 : IF(CRIT1.LE.0.D0.AND.CRIT2.LE.0.D0) GO TO 23 326 : SIG0P(1)=SIG0P(1)-SIMER 327 : SIG0P(2)=SIG0P(2)-SIMER 328 : DSIGPP(1)=DSIGPP(1)+SIMER 329 : DSIGPP(2)=DSIGPP(2)+SIMER 330 : C 331 : DO 19 I=1,6 332 : SIGMAT(I)=SIG0P(I) 333 : DSIGMA(I)=DSIGPP(I) 334 : 19 CONTINUE 335 : C 336 : C RETOUR DANS LES AXES 337 : C 338 : WW1(1)=SIGMAT(1) 339 : WW1(2)=SIGMAT(2) 340 : WW1(3)=SIGMAT(4) 341 : C 341 : CALL RETOUR(WW1,SIGMAT,CC,SS,CS,LUNE) 342 : C 343 : WW1(1)=DSIGMA(1) 344 : WW1(2)=DSIGMA(2) 345 : WW1(3)=DSIGMA(4) 346 : C 346 : CALL RETOUR(WW1,DSIGMA,CC,SS,CS,LUNE) 347 : C 347 : CALL GAMTR(SIGMAT,DSIGMA,F1ST,F2ST,R1,R2,CC,SS,CS,ITRAC,IRZ, 348 : . GAMMA,PREC,RFSG,RFEP,RFPR,KERRE) 349 : IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA 350 : IF(GAMMA.GE.1.D0) GO TO 23 351 : IF(GAMMA.LT.0.D0) GAMMA=0.D0 352 : C 353 : C CORRECTION DES INCREMENTS DE CONTRAINTES 354 : C 355 : IF(IIMPI.EQ.9) WRITE(IOIMP,7001) (SIGEL(I),I=1,6) 356 : DSIGPP(1)=DSIGPP(1)*GAMMA 357 : DSIGPP(2)=DSIGPP(2)*GAMMA 358 : DSIGPP(4)=DSIGPP(4)*GAMMA 359 : DO 20 I=1,6 360 : SIGEL(I)=SIG0P(I)+DSIGPP(I) 361 : DSIGP(I)=DSIGP(I)*(1.D0-GAMMA) 362 : 20 CONTINUE 363 : C 364 : C RETOUR DANS LES AXES 365 : C 366 : WW1(1)=SIGEL(1) 367 : WW1(2)=SIGEL(2) 368 : WW1(3)=SIGEL(4) 369 : C 369 : CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE) 370 : C 371 : ITETA=ITETA+IRZ+3 372 : IND1=0 373 : IND2=0 374 : IND3=0 375 : IND=0 376 : SIMER=0.D0 377 : GO TO 24 378 : C 379 : C*********************************************************************** 380 : C************************* FISSURATION EN (RZ) PUIS EN (@) ************* 381 : C*********************************************************************** 382 : C 383 : 22 GO TO(31,32,33),IND 384 : WRITE(IOIMP,1000)IND 385 : KERRE=640 386 : RETURN 387 : C 388 : C****************** FISSURATION EN (R) PUIS EN (Z) ET (@) ************** 389 : C 390 : 31 WW1(2)=ROTA(SIGEL,CC,SS,CS,2) 391 : CRIT=WW1(2)-R2 392 : IF(CRIT.LE.0.D0) GO TO 33 393 : C 394 : CRIT3=SIGEL(3)-R3 395 : IF(CRIT3.LE.0.D0) GO TO 205 396 : C 397 : SIG0P(2)=SIG0P(2)-SIMER 398 : SIG0P(3)=SIG0P(3)-SIMER 399 : DSIGPP(2)=DSIGPP(2)+SIMER 400 : DSIGPP(3)=DSIGPP(3)+SIMER 401 : C 402 : IF(DSIGPP(2).EQ.0.D0) GO TO 28 403 : GAMM1=(R2-SIG0P(2))/DSIGPP(2) 404 : IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM1 405 : IF(GAMM1.LT.0.D0) GAMM1=0.D0 406 : IF(GAMM1.GE.0.D0.AND.GAMM1.LT.1.D0) GO TO 29 407 : 28 GAMM1=100.D0 408 : 29 GAMM2=GAMTT(SIG0P(3),DSIGPP(3),R3) 409 : IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM2 410 : IF(GAMM2.GE.1.D0) GAMM2=100.D0 411 : IF(GAMM2.LT.0.D0) GAMM2=0.D0 412 : GAMMA=DMIN1(GAMM1,GAMM2) 413 : IF(GAMMA.GE.1.D0) GO TO 23 414 : C 415 : IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA 416 : ITETA=1 417 : IF(GAMMA.EQ.GAMM1) ITETA=2 418 : DENOR=DMIN1(GAMM1,GAMM2) 419 : DENOR=DMAX1(DENOR,RFPR) 420 : DIF=ABS(GAMM1-GAMM2)/DENOR 421 : IF(DIF.LE.PREC) ITETA=3 422 : GO TO(41,42,43),ITETA 423 : KERRE=640 424 : RETURN 425 : C 426 : C FISSURATION EN (R) PUIS EN (@) 427 : C 428 : 41 DSIGPP(2)=DSIGPP(2)*GAMMA 429 : ITETA=2 430 : GO TO 47 431 : C 432 : C FISSURATION EN (R) PUIS EN (Z) 433 : C 434 : 42 DSIGPP(2)=DSIGPP(2)*GAMMA 435 : DSIGPP(3)=DSIGPP(3)*GAMMA 436 : ITETA=2 437 : GO TO 30 438 : C 439 : C FISSURATION EN (R) PUIS EN (Z@) 440 : C 441 : 43 DSIGPP(2)=DSIGPP(2)*GAMMA 442 : ITETA=4 443 : IRZ=3 444 : GO TO 47 445 : C 446 : C******************** FISSURATION EN (Z) PUIS EN (R) ET (@) ************ 447 : C 448 : 32 WW1(1)=ROTA(SIGEL,CC,SS,CS,1) 449 : CRIT=WW1(1)-R1 450 : IF(CRIT.LE.0.D0) GO TO 33 451 : C 452 : CRIT3=SIGEL(3)-R3 453 : IF(CRIT3.LE.0.D0) GO TO 206 454 : C 455 : SIG0P(1)=SIG0P(1)-SIMER 456 : SIG0P(3)=SIG0P(3)-SIMER 457 : DSIGPP(1)=DSIGPP(1)+SIMER 458 : DSIGPP(3)=DSIGPP(3)+SIMER 459 : C 460 : IF(DSIGPP(1).EQ.0.D0) GO TO 35 461 : GAMM1=(R1-SIG0P(1))/DSIGPP(1) 462 : IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM1 463 : IF(GAMM1.LT.0.D0) GAMM1=0.D0 464 : IF(GAMM1.GE.0.D0.AND.GAMM1.LT.1.D0) GO TO 36 465 : 35 GAMM1=100.D0 466 : 36 GAMM2=GAMTT(SIG0P(3),DSIGPP(3),R3) 467 : IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM2 468 : IF(GAMM2.GE.1.D0) GAMM2=100.D0 469 : IF(GAMM2.LT.0.D0) GAMM2=0.D0 470 : GAMMA=DMIN1(GAMM1,GAMM2) 471 : IF(GAMMA.GE.1.D0) GO TO 23 472 : C 473 : IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA 474 : ITETA=1 475 : IF(GAMMA.EQ.GAMM1) ITETA=2 476 : DENOR=DMIN1(GAMM1,GAMM2) 477 : DENOR=DMAX1(DENOR,RFPR) 478 : DIF=ABS(GAMM1-GAMM2)/DENOR 479 : IF(DIF.LE.PREC) ITETA=3 480 : GO TO(51,52,53),ITETA 481 : WRITE(IOIMP,1001)ITETA 482 : KERRE=640 483 : RETURN 484 : C 485 : C FISSURATION EN (Z) PUIS EN (@) 486 : C 487 : 51 DSIGPP(1)=DSIGPP(1)*GAMMA 488 : ITETA=3 489 : GO TO 47 490 : C 491 : C FISSURATION EN (Z) PUIS EN (R) 492 : C 493 : 52 DSIGPP(2)=DSIGPP(2)*GAMMA 494 : DSIGPP(3)=DSIGPP(3)*GAMMA 495 : ITETA=3 496 : GO TO 37 497 : C 498 : C FISSURATION EN (Z) PUIS EN (R@) 499 : C 500 : 53 DSIGPP(1)=DSIGPP(1)*GAMMA 501 : ITETA=4 502 : IRZ=3 503 : GO TO 47 504 : C 505 : C********************* FISSURATION EN (RZ) PUIS EN (@) ***************** 506 : C 507 : 33 CRIT3=SIGEL(3)-R3 508 : IF(CRIT3.LE.0.D0) GO TO 23 509 : SIG0P(3)=SIG0P(3)-SIMER 510 : DSIGPP(3)=DSIGPP(3)+SIMER 511 : C 512 : GAMMA=GAMTT(SIG0P(3),DSIGPP(3),R3) 513 : IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA 514 : IF(GAMMA.GE.1.D0) GO TO 23 515 : IF(GAMMA.LT.0.D0) GAMMA=0.D0 516 : C 517 : C CORRECTION DES INCREMENTS DE CONTRAINTES 518 : C 519 : GO TO(61,62,63),IND 520 : WRITE(IOIMP,1000)IND 521 : KERRE=640 522 : RETURN 523 : C 524 : C FISSURE EN (R) PUIS EN (@) 525 : C 526 : 61 DSIGPP(2)=DSIGPP(2)*GAMMA-(1.D0-GAMMA)*SIMER 527 : ITETA=2 528 : GO TO 47 529 : C 530 : C FISSURE EN (Z) PUIS EN (@) 531 : C 532 : 62 DSIGPP(1)=DSIGPP(1)*GAMMA-(1.D0-GAMMA)*SIMER 533 : ITETA=3 534 : GO TO 47 535 : C 536 : C FISSURE EN (RZ) PUIS EN (@) 537 : C 538 : 63 ITETA=4 539 : 47 DSIGPP(3)=DSIGPP(3)*GAMMA 540 : C 541 : DO 39 I=1,6 542 : SIGEL(I)=SIG0P(I)+DSIGPP(I) 543 : DSIGP(I)=DSIGP(I)*(1.D0-GAMMA) 544 : 39 CONTINUE 545 : C 546 : C RETOUR DANS LES AXES 547 : C 548 : WW1(1)=SIGEL(1) 549 : WW1(2)=SIGEL(2) 550 : WW1(3)=SIGEL(4) 551 : C 551 : CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE) 552 : C 553 : ITETA=ITETA+3 554 : IND1=0 555 : IND2=0 556 : IND3=0 557 : IND=0 558 : JTRAC=ITRAC 559 : SIMER=0.D0 560 : GO TO 24 561 : C 562 : C*********************************************************************** 563 : C********************** FISSURATION EN (R@) PUIS EN (Z) **************** 564 : C*********************************************************************** 565 : C 566 : 25 WW1(2)=ROTA(SIGEL,CC,SS,CS,2) 567 : CRIT=WW1(2)-R2 568 : IF(CRIT.LE.0.D0) GO TO 23 569 : 205 SIG0P(2)=SIG0P(2)-SIMER 570 : DSIGPP(2)=DSIGPP(2)+SIMER 571 : IF(DSIGPP(2).EQ.0.D0) GO TO 23 572 : GAMMA=(R2-SIG0P(2))/DSIGPP(2) 573 : IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA 574 : IF(GAMMA.GE.1.D0) GO TO 23 575 : IF(GAMMA.LT.0.D0) GAMMA=0.D0 576 : IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA 577 : DSIGPP(2)=DSIGPP(2)*GAMMA 578 : IF(ITETA.EQ.2) DSIGPP(3)=DSIGPP(3)*GAMMA-(1.D0-GAMMA)*SIMER 579 : 30 DO 44 I=1,6 580 : SIGEL(I)=SIG0P(I)+DSIGPP(I) 581 : DSIGP(I)=DSIGP(I)*(1.D0-GAMMA) 582 : 44 CONTINUE 583 : C 584 : C RETOUR DANS LES AXES 585 : C 586 : WW1(1)=SIGEL(1) 587 : WW1(2)=SIGEL(2) 588 : WW1(3)=SIGEL(4) 589 : C 589 : CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE) 590 : C 591 : ITETA=ITETA+2 592 : IND1=0 593 : IND2=0 594 : IND3=0 595 : IND=0 596 : IRZ=3 597 : JTRAC=ITRAC 598 : SIMER=0.D0 599 : GO TO 24 600 : C 601 : C*********************************************************************** 602 : C*********************** FISSURATION EN (Z@) PUIS EN (R) *************** 603 : C*********************************************************************** 604 : C 605 : 26 WW1(1)=ROTA(SIGEL,CC,SS,CS,1) 606 : CRIT=WW1(1)-R1 607 : IF(CRIT.LE.0.D0) GO TO 23 608 : 206 SIG0P(1)=SIG0P(1)-SIMER 609 : DSIGPP(1)=DSIGPP(1)+SIMER 610 : IF(DSIGPP(1).EQ.0.D0) GO TO 23 611 : GAMMA=(R1-SIG0P(1))/DSIGPP(1) 612 : IF(GAMMA.GE.1.D0) GO TO 23 613 : IF(GAMMA.LT.0.D0) GAMMA=0.D0 614 : DSIGPP(1)=DSIGPP(1)*GAMMA 615 : IF(ITETA.EQ.2) DSIGPP(3)=DSIGPP(3)*GAMMA-(1.D0-GAMMA)*SIMER 616 : 37 DO 46 I=1,6 617 : SIGEL(I)=SIG0P(I)+DSIGPP(I) 618 : DSIGP(I)=DSIGP(I)*(1.D0-GAMMA) 619 : 46 CONTINUE 620 : C 621 : C RETOUR DANS LES AXES 622 : C 623 : WW1(1)=SIGEL(1) 624 : WW1(2)=SIGEL(2) 625 : WW1(3)=SIGEL(4) 626 : C 626 : CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE) 627 : C 628 : ITETA=ITETA+1 629 : IND1=0 630 : IND2=0 631 : IND3=0 632 : IND=0 633 : IRZ=3 634 : JTRAC=ITRAC 635 : SIMER=0.D0 636 : GO TO 24 637 : C 638 : C*********************************************************************** 639 : C****************************** PAS DE COUPLAGE ************************ 640 : C*********************************************************************** 641 : C 642 : 23 ITENS=ITENRZ+ITENTE 643 : DO 9 III=1,6 644 : SIGMAT(III)=SIGEL(III) 645 : 9 CONTINUE 646 : GO TO 300 647 : C 648 : C*********************************************************************** 649 : C****************************** LES FISSURES SE FERMENT **************** 650 : C*********************************************************************** 651 : C 652 : 4 CONTINUE 653 : IF(IIMPI.EQ.9) WRITE(IOIMP,7002) (SIGMAT(I),I=1,6) 654 : DO 10 III=1,6 655 : SIGEL(III)=SIGMAT(III) 656 : 10 CONTINUE 657 : C 658 : C*********************************************************************** 659 : C**** CALCUL DE LA QUANTITE DE CONTRAINTE A ECOULER AVEC LE CRITERE **** 660 : C* DE LA TRACTION AVANT D ARRIVER AU CRITERE DE DRUCKER PRAGER ECROUI * 661 : C*********************************************************************** 662 : C 663 : 300 IF(IBAB.EQ.1) GO TO 331 664 : IF(ICTD.EQ.1) GO TO 332 664 : CALL KRITER(5,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, 665 : .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE) 666 : IF(CRIT.LE.0.D0) GO TO 331 667 : C 668 : C RETOUR DANS LES AXES 669 : C 670 : WW1(1)=SIGMA(1) 671 : WW1(2)=SIGMA(2) 672 : WW1(3)=SIGMA(4) 673 : C 673 : CALL RETOUR(WW1,SIGMA,CC,SS,CS,LUNE) 674 : C 675 : DO 301 I=1,6 676 : DSIGMA(I)=SIGMAT(I)-SIGMA(I) 677 : 301 CONTINUE 678 : C 679 : C CALCUL DE GAMMA CISAILLEMENT 680 : C 681 : GAMCIS=GAMDP(SIGMA,DSIGMA,ALFAD2,DPELA2,ICONCA, 682 : . PREC,RFSG,RFEP,RFPR) 683 : IF(IIMPI.EQ.9) WRITE(IOIMP,7013) (SIGMA(I),I=1,6) 684 : IF(IIMPI.EQ.9) WRITE(IOIMP,7014) (DSIGMA(I),I=1,6) 685 : IF(IIMPI.EQ.9) WRITE(IOIMP,7007) GAMCIS,CRIT 686 : IF(GAMCIS.GE.1.D0) GO TO 331 687 : IF(GAMCIS.LT.0.D0) GAMCIS=0.D0 688 : IF(GAMCIS.LT.RFPR*PREC) GAMCIS=0.D0 689 : C 690 : C ON RECOMMENCE AVEC GAMCIS*DSIGP AU LIEU DE DSIGP 691 : C 692 : DO 302 I=1,6 693 : SIGEL(I)=SIGEL0(I) 694 : DSIGP(I)=GAMCIS*DSIGP0(I) 695 : 302 CONTINUE 696 : R1=R10 697 : R2=R20 698 : R3=R30 699 : TETAQ=TETAQ0 700 : ITRAC=ITRAC0 701 : ITETA=ITETA0 702 : IRZ=IRZ0 703 : ICTD=1 704 : IF(GAMCIS.NE.0.D0) GO TO 96 705 : ITENS=0 706 : ITENRZ=0 707 : ITENTE=0 708 : GO TO 332 709 : C 710 : C*********************************************************************** 711 : C**************************** LA SORTIE ******************************** 712 : C*********************************************************************** 713 : C 714 : 331 DO 303 I=1,6 715 : SIGMA(I)=SIGEL(I) 716 : DSIGMA(I)=0.D0 717 : DSIGP(I)=0.D0 718 : 303 CONTINUE 719 : GO TO 333 720 : C 721 : 332 DO 304 I=1,6 722 : SIGMA(I)=SIGEL(I) 723 : DSIGMA(I)=DSIGP0(I)*(1.D0-GAMCIS) 724 : SIGMAT(I)=SIGMA(I)+DSIGMA(I) 725 : DSIGP(I)=DSIGMA(I) 726 : 304 CONTINUE 727 : C 727 : 333 IF(IBAB.EQ.0) CALL KRITER(5,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, 728 : .DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGEL,FSIG,CRIT, 729 : .KERRE) 730 : IF(IIMPI.EQ.9) 731 : . WRITE(IOIMP,7009) CRIT,R1,R2,R3,TETAQ,ICTD,ITRAC,ITENRZ, 732 : . ITENTE,ITENS 733 : IF(IIMPI.EQ.9) WRITE(IOIMP,7013) (SIGMA(I),I=1,6) 734 : IF(IIMPI.EQ.9) WRITE(IOIMP,7014) (DSIGMA(I),I=1,6) 735 : IF(IIMPI.EQ.9) WRITE(IOIMP,7002) (SIGMAT(I),I=1,6) 736 : IF(IIMPI.EQ.9) WRITE(IOIMP,7001) (SIGEL(I),I=1,6) 737 : IF(IIMPI.EQ.9) WRITE(IOIMP,7006) (DSIGP(I),I=1,6) 738 : C 739 : 1000 FORMAT(1X,'ERREUR DANS CRACK DANS LA VALEUR DE IND =',I4) 740 : 1001 FORMAT(1X,'ERREUR DANS CRACK DANS LA VALEUR DE ITETA =',I4) 741 : 1002 FORMAT(1X,'ERREUR DANS CRACK PAS DE CONVERGENCE ITER =',I4) 742 : 7000 FORMAT(1X,'ITRAC =',I4,1X,'ITENRZ=',I4,1X,'ITENTE=',I4,/, 743 : . 1X,'ITETA =',I4,1X,'IRZ =',I4,1X,'ITER =',I4) 744 : 7001 FORMAT(1X,'SIGEL =',6(1X,1PD12.5)) 745 : 7002 FORMAT(1X,'SIGMAT=',6(1X,1PD12.5)) 746 : 7003 FORMAT(1X,'SIG0P =',6(1X,1PD12.5)) 747 : 7004 FORMAT(1X,'DSIGPP=',6(1X,1PD12.5)) 748 : 7005 FORMAT(1X,'SIGTP =',6(1X,1PD12.5)) 749 : 7006 FORMAT(1X,'DSIGP =',6(1X,1PD12.5)) 750 : 7007 FORMAT(1X,'GAMCIS=',1PD12.5,1X,'CRIT =',1PD12.5) 751 : 7008 FORMAT(1X,'GAMMA =',1PD12.5) 752 : 7009 FORMAT(1X,'CRIT =',1PD12.5,1X,'R1 =',1PD12.5, 753 : . 1X,'R2 =',1PD12.5,/, 754 : . 1X,'R3 =',1PD12.5,1X,'TETAQ =',1PD12.5,/, 755 : . 1X,'ICTD =',I4,1X,'ITRAC =',I4,1X,'ITENRZ=',I4, 756 : . 1X,'ITENTE=',I4,1X,'ITENS =',I4) 757 : 7011 FORMAT(1X,'IND =',I4,1X,'IND1 =',I4, 758 : . 1X,'IND2 =',I4,1X,'IND3 =',I4) 759 : 7012 FORMAT(1X,'ITETA =',I4) 760 : 7013 FORMAT(1X,'SIGMA =',6(1X,1PD12.5)) 761 : 7014 FORMAT(1X,'DSIGMA=',6(1X,1PD12.5)) 762 : C 763 : RETURN 764 : END 765 :
© Cast3M 2003 - All rights reserved.
Disclaimer