C CRACK SOURCE CB215821 17/11/30 21:15:47 9639 SUBROUTINE CRACK(SIGMAT,SIGEL,DSIGP,R1,R2,R3,TETAQ,ITRAC,ITENS, .ITENRZ,ITENTE,ITETA,IRZ,SIGMA,DSIGMA,YUNG,XNU, .ALFAD2,DPELA2,PENTE2,IBAB,ICTD,KASTR, .PREC,RFSG,RFEP,RFPR,KERRE) C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO C DIMENSION SIGEL(*),DSIGP(*) DIMENSION SIGMAT(6),WW1(3),SIGMA(6),DSIGP0(6) DIMENSION SIGTP(6),SIG0P(6),DSIGPP(6),DSIGMA(6),SIGEL0(6) C C INITIALISATION DES VARIABLES C CRIT= 0.D0 GAMCIS=0.D0 F1ST=0.D0 F2ST=0.D0 C C SI ON N A PAS LE DROIT D ECOULER SELON LE CRITERE DE LA TRACTION C IF(KASTR.NE.2) GO TO 99 DO 199 I=1,6 SIGMA(I)=SIGEL(I) DSIGMA(I)=DSIGP(I) 199 CONTINUE ICTD=1 GO TO 333 C C INITIALISATION C 99 R10=R1 R20=R2 R30=R3 TETAQ0=TETAQ ITRAC0=ITRAC ITETA0=ITETA IRZ0=IRZ DO 100 I=1,6 SIGEL0(I)=SIGEL(I) DSIGP0(I)=DSIGP(I) 100 CONTINUE UNIT=0.01745329252D0 LUNE=1 ICONCA=0 ITER=0 ICTD=0 ZER=0.D0 C 96 IND=0 IND1=0 IND2=0 IND3=0 JTRAC=ITRAC ITENS=0 ITENRZ=0 ITENTE=0 SIMER=0.D0 C C ROTATION DES AXES C 24 IF(ITER.LE.12) GO TO 48 WRITE(IOIMP,1002) ITER KERRE=640 RETURN C 48 ITER=ITER+1 IF(IIMPI.EQ.9) WRITE(IOIMP,7001) (SIGEL(I),I=1,6) IF(IIMPI.EQ.9) WRITE(IOIMP,7006) (DSIGP(I),I=1,6) IF(IIMPI.EQ.9) . WRITE(IOIMP,7000) ITRAC,ITENRZ,ITENTE,ITETA,IRZ,ITER C IF(ITRAC.GT.0) GO TO 1 WW1(1)=SIGEL(1) WW1(2)=SIGEL(2) WW1(3)=SIGEL(4) CALL DIAGOD(WW1) TETAQ=WW1(3) C 1 ANRUP=TETAQ*UNIT CO=COS(ANRUP) SII=SIN(ANRUP) CC=CO*CO SS=SII*SII CS=CO*SII C IF(ITRAC.GT.0) WW1(1)=ROTA(SIGEL,CC,SS,CS,1) IF(ITRAC.GT.0) WW1(2)=ROTA(SIGEL,CC,SS,CS,2) SIG0P(1)=WW1(1) SIG0P(2)=WW1(2) SIG0P(3)=SIGEL(3) SIG0P(4)=0.D0 IF(ITRAC.GT.0) SIG0P(4)=ROTA(SIGEL,CC,SS,CS,3) SIG0P(5)=0.D0 SIG0P(6)=0.D0 C DSIGPP(1)=ROTA(DSIGP,CC,SS,CS,1) DSIGPP(2)=ROTA(DSIGP,CC,SS,CS,2) DSIGPP(3)=DSIGP(3) DSIGPP(4)=ROTA(DSIGP,CC,SS,CS,3) DSIGPP(5)=0.D0 DSIGPP(6)=0.D0 C IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 70 DO 2 I=1,6 SIGMA(I)=SIG0P(I) 2 CONTINUE IF(IIMPI.EQ.9) WRITE(IOIMP,7013) (SIGMA(I),I=1,6) C 70 DO 3 I=1,6 SIGTP(I)=SIG0P(I)+DSIGPP(I) SIGMAT(I)=SIGEL(I)+DSIGP(I) 3 CONTINUE C IF(IIMPI.EQ.9) WRITE(IOIMP,7003) (SIG0P(I),I=1,6) IF(IIMPI.EQ.9) WRITE(IOIMP,7004) (DSIGPP(I),I=1,6) IF(IIMPI.EQ.9) WRITE(IOIMP,7005) (SIGTP(I),I=1,6) C CRIT1=SIGTP(1)-R1 CRIT2=SIGTP(2)-R2 CRIT3=SIGTP(3)-R3 C IF(CRIT1.LE.0.D0.AND.CRIT2.LE.0.D0.AND.CRIT3.LE.0.D0) GO TO 4 C UNMU=XNU/(1.D0-XNU) IF(CRIT1.GT.0.D0.AND.ITETA.NE.1.AND.IRZ.NE.2) IND1=1 IF(CRIT2.GT.0.D0.AND.ITETA.NE.1.AND.IRZ.NE.1) IND2=2 IF(CRIT3.GT.0.D0.AND.ITETA.NE.2) IND3=4 IND=IND1+IND2+IND3 IF(IIMPI.EQ.9) WRITE(IOIMP,7011) IND,IND1,IND2,IND3 GO TO(11,12,14,13,15,16,17),IND WRITE(IOIMP,1000)IND KERRE=640 RETURN C C*********************************************************************** C*************************** CAS D UNE SEULE FISSURE ******************* C*********************************************************************** C C FISSURE DANS LA DIRECTION (R) C 11 DSIGPP(1)=-SIG0P(1) DSIGPP(4)=-SIG0P(4) DSIGPP(6)=-SIG0P(6) DSIGPP(2)=DSIGPP(2)-SIGTP(1)*UNMU DSIGPP(3)=DSIGPP(3)-SIGTP(1)*UNMU SIMER=SIG0P(1)*UNMU R1=0.D0 ITENRZ=1 ITRAC=1 IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 5 SIGMA(1)=0.D0 SIGMA(2)=SIGMA(2)-SIMER SIGMA(3)=SIGMA(3)-SIMER SIGMA(4)=0.D0 SIGMA(6)=0.D0 GO TO 5 C C FISSURE DANS LA DIRECTION (Z) C 12 DSIGPP(2)=-SIG0P(2) DSIGPP(4)=-SIG0P(4) DSIGPP(5)=-SIG0P(5) DSIGPP(1)=DSIGPP(1)-SIGTP(2)*UNMU DSIGPP(3)=DSIGPP(3)-SIGTP(2)*UNMU SIMER=SIG0P(2)*UNMU R2=0.D0 ITENRZ=1 ITRAC=1 IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 5 SIGMA(1)=SIGMA(1)-SIMER SIGMA(2)=0.D0 SIGMA(3)=SIGMA(3)-SIMER SIGMA(4)=0.D0 SIGMA(5)=0.D0 GO TO 5 C C FISSURE DANS LA DIRECTION (@) C 13 DSIGPP(3)=-SIG0P(3) DSIGPP(5)=-SIG0P(5) DSIGPP(6)=-SIG0P(6) DSIGPP(1)=DSIGPP(1)-SIGTP(3)*UNMU DSIGPP(2)=DSIGPP(2)-SIGTP(3)*UNMU SIMER=SIG0P(3)*UNMU R3=0.D0 ITENTE=1 IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 5 SIGMA(1)=SIGMA(1)-SIMER SIGMA(2)=SIGMA(2)-SIMER SIGMA(3)=0.D0 SIGMA(5)=0.D0 SIGMA(6)=0.D0 GO TO 5 C C*********************************************************************** C*************************** CAS DE DEUX FISSURES ********************** C*********************************************************************** C C DEUX FISSURES DANS LE PLAN (RZ) C 14 DSIGPP(1)=-SIG0P(1) DSIGPP(2)=-SIG0P(2) DSIGPP(3)=DSIGPP(3)-XNU*(SIGTP(1)+SIGTP(2)) SIMER=XNU*(SIG0P(1)+SIG0P(2)) R1=0.D0 R2=0.D0 ITENRZ=2 ITRAC=1 IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6 SIGMA(1)=0.D0 SIGMA(2)=0.D0 SIGMA(3)=SIGMA(3)-SIMER SIGMA(4)=0.D0 SIGMA(5)=0.D0 SIGMA(6)=0.D0 GO TO 6 C C DEUX FISSURES DANS LE PLAN (R@) C 15 DSIGPP(1)=-SIG0P(1) DSIGPP(3)=-SIG0P(3) DSIGPP(2)=DSIGPP(2)-XNU*(SIGTP(1)+SIGTP(3)) SIMER=XNU*(SIG0P(1)+SIG0P(3)) R1=0.D0 R3=0.D0 ITENRZ=1 ITENTE=1 ITRAC=1 IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6 SIGMA(1)=0.D0 SIGMA(2)=SIGMA(2)-SIMER SIGMA(3)=0.D0 SIGMA(4)=0.D0 SIGMA(5)=0.D0 SIGMA(6)=0.D0 GO TO 6 C C DEUX FISSURES DANS LE PLAN (Z@) C 16 DSIGPP(2)=-SIG0P(2) DSIGPP(3)=-SIG0P(3) DSIGPP(1)=DSIGPP(1)-XNU*(SIGTP(2)+SIGTP(3)) SIMER=XNU*(SIG0P(2)+SIG0P(3)) R2=0.D0 R3=0.D0 ITENRZ=1 ITENTE=1 ITRAC=1 IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6 SIGMA(1)=SIGMA(1)-SIMER SIGMA(2)=0.D0 SIGMA(3)=0.D0 SIGMA(4)=0.D0 SIGMA(5)=0.D0 SIGMA(6)=0.D0 GO TO 6 C C*********************************************************************** C***************************** CAS DE TROIS FISSURES ******************* C*********************************************************************** C 17 DSIGPP(1)=-SIG0P(1) DSIGPP(2)=-SIG0P(2) DSIGPP(3)=-SIG0P(3) R1=0.D0 R2=0.D0 R3=0.D0 ITENRZ=2 ITENTE=1 ITRAC=1 IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6 DO 8 I=1,6 SIGMA(I)=0.D0 8 CONTINUE C 6 DSIGPP(4)=-SIG0P(4) DSIGPP(5)=-SIG0P(5) DSIGPP(6)=-SIG0P(6) C 5 DO 7 I=1,6 SIGTP(I)=SIG0P(I)+DSIGPP(I) 7 CONTINUE C IF(IIMPI.EQ.9) WRITE(IOIMP,7005) (SIGTP(I),I=1,6) C C LE RETOUR DANS LES AXES C WW1(1)=SIGTP(1) WW1(2)=SIGTP(2) WW1(3)=SIGTP(4) C CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE) C SIGEL(3)=SIGTP(3) SIGEL(5)=0.D0 SIGEL(6)=0.D0 C IF(ITENRZ.EQ.0.AND.JTRAC.EQ.0) TETAQ=0.D0 IF(IIMPI.EQ.9) . WRITE(IOIMP,7000) ITRAC,ITENRZ,ITENTE,ITETA,IRZ,ITER C IF(ITETA.EQ.3.AND.IRZ.EQ.1) ITETA=5 IF(ITETA.EQ.3.AND.IRZ.EQ.2) ITETA=6 IF(IIMPI.EQ.9) WRITE(IOIMP,7012) ITETA GO TO(21,22,23,33,25,26,23),ITETA WRITE(IOIMP,1001)ITETA KERRE=640 RETURN C C*********************************************************************** C*************************** FISSURATION EN (@) PUIS EN (RZ) *********** C*********************************************************************** C 21 IF(ITRAC.GT.0) GO TO 18 WW1(1)=SIGEL(1) WW1(2)=SIGEL(2) WW1(3)=SIGEL(4) CALL DIAGOD(WW1) F1ST=WW1(1) F2ST=WW1(2) 18 IF(ITRAC.GT.0) F1ST=ROTA(SIGEL,CC,SS,CS,1) IF(ITRAC.GT.0) F2ST=ROTA(SIGEL,CC,SS,CS,2) CRIT1=F1ST-R1 CRIT2=F2ST-R2 IF(CRIT1.LE.0.D0.AND.CRIT2.LE.0.D0) GO TO 23 SIG0P(1)=SIG0P(1)-SIMER SIG0P(2)=SIG0P(2)-SIMER DSIGPP(1)=DSIGPP(1)+SIMER DSIGPP(2)=DSIGPP(2)+SIMER C DO 19 I=1,6 SIGMAT(I)=SIG0P(I) DSIGMA(I)=DSIGPP(I) 19 CONTINUE C C RETOUR DANS LES AXES C WW1(1)=SIGMAT(1) WW1(2)=SIGMAT(2) WW1(3)=SIGMAT(4) C CALL RETOUR(WW1,SIGMAT,CC,SS,CS,LUNE) C WW1(1)=DSIGMA(1) WW1(2)=DSIGMA(2) WW1(3)=DSIGMA(4) C CALL RETOUR(WW1,DSIGMA,CC,SS,CS,LUNE) C CALL GAMTR(SIGMAT,DSIGMA,F1ST,F2ST,R1,R2,CC,SS,CS,ITRAC,IRZ, . GAMMA,PREC,RFSG,RFEP,RFPR,KERRE) IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA IF(GAMMA.GE.1.D0) GO TO 23 IF(GAMMA.LT.0.D0) GAMMA=0.D0 C C CORRECTION DES INCREMENTS DE CONTRAINTES C IF(IIMPI.EQ.9) WRITE(IOIMP,7001) (SIGEL(I),I=1,6) DSIGPP(1)=DSIGPP(1)*GAMMA DSIGPP(2)=DSIGPP(2)*GAMMA DSIGPP(4)=DSIGPP(4)*GAMMA DO 20 I=1,6 SIGEL(I)=SIG0P(I)+DSIGPP(I) DSIGP(I)=DSIGP(I)*(1.D0-GAMMA) 20 CONTINUE C C RETOUR DANS LES AXES C WW1(1)=SIGEL(1) WW1(2)=SIGEL(2) WW1(3)=SIGEL(4) C CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE) C ITETA=ITETA+IRZ+3 IND1=0 IND2=0 IND3=0 IND=0 SIMER=0.D0 GO TO 24 C C*********************************************************************** C************************* FISSURATION EN (RZ) PUIS EN (@) ************* C*********************************************************************** C 22 GO TO(31,32,33),IND WRITE(IOIMP,1000)IND KERRE=640 RETURN C C****************** FISSURATION EN (R) PUIS EN (Z) ET (@) ************** C 31 WW1(2)=ROTA(SIGEL,CC,SS,CS,2) CRIT=WW1(2)-R2 IF(CRIT.LE.0.D0) GO TO 33 C CRIT3=SIGEL(3)-R3 IF(CRIT3.LE.0.D0) GO TO 205 C SIG0P(2)=SIG0P(2)-SIMER SIG0P(3)=SIG0P(3)-SIMER DSIGPP(2)=DSIGPP(2)+SIMER DSIGPP(3)=DSIGPP(3)+SIMER C IF(DSIGPP(2).EQ.0.D0) GO TO 28 GAMM1=(R2-SIG0P(2))/DSIGPP(2) IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM1 IF(GAMM1.LT.0.D0) GAMM1=0.D0 IF(GAMM1.GE.0.D0.AND.GAMM1.LT.1.D0) GO TO 29 28 GAMM1=100.D0 29 GAMM2=GAMTT(SIG0P(3),DSIGPP(3),R3) IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM2 IF(GAMM2.GE.1.D0) GAMM2=100.D0 IF(GAMM2.LT.0.D0) GAMM2=0.D0 GAMMA=MIN(GAMM1,GAMM2) IF(GAMMA.GE.1.D0) GO TO 23 C IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA ITETA=1 IF(GAMMA.EQ.GAMM1) ITETA=2 DENOR=MIN(GAMM1,GAMM2) DENOR= MAX(DENOR,RFPR) DIF=ABS(GAMM1-GAMM2)/DENOR IF(DIF.LE.PREC) ITETA=3 GO TO(41,42,43),ITETA KERRE=640 RETURN C C FISSURATION EN (R) PUIS EN (@) C 41 DSIGPP(2)=DSIGPP(2)*GAMMA ITETA=2 GO TO 47 C C FISSURATION EN (R) PUIS EN (Z) C 42 DSIGPP(2)=DSIGPP(2)*GAMMA DSIGPP(3)=DSIGPP(3)*GAMMA ITETA=2 GO TO 30 C C FISSURATION EN (R) PUIS EN (Z@) C 43 DSIGPP(2)=DSIGPP(2)*GAMMA ITETA=4 IRZ=3 GO TO 47 C C******************** FISSURATION EN (Z) PUIS EN (R) ET (@) ************ C 32 WW1(1)=ROTA(SIGEL,CC,SS,CS,1) CRIT=WW1(1)-R1 IF(CRIT.LE.0.D0) GO TO 33 C CRIT3=SIGEL(3)-R3 IF(CRIT3.LE.0.D0) GO TO 206 C SIG0P(1)=SIG0P(1)-SIMER SIG0P(3)=SIG0P(3)-SIMER DSIGPP(1)=DSIGPP(1)+SIMER DSIGPP(3)=DSIGPP(3)+SIMER C IF(DSIGPP(1).EQ.0.D0) GO TO 35 GAMM1=(R1-SIG0P(1))/DSIGPP(1) IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM1 IF(GAMM1.LT.0.D0) GAMM1=0.D0 IF(GAMM1.GE.0.D0.AND.GAMM1.LT.1.D0) GO TO 36 35 GAMM1=100.D0 36 GAMM2=GAMTT(SIG0P(3),DSIGPP(3),R3) IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM2 IF(GAMM2.GE.1.D0) GAMM2=100.D0 IF(GAMM2.LT.0.D0) GAMM2=0.D0 GAMMA=MIN(GAMM1,GAMM2) IF(GAMMA.GE.1.D0) GO TO 23 C IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA ITETA=1 IF(GAMMA.EQ.GAMM1) ITETA=2 DENOR=MIN(GAMM1,GAMM2) DENOR= MAX(DENOR,RFPR) DIF=ABS(GAMM1-GAMM2)/DENOR IF(DIF.LE.PREC) ITETA=3 GO TO(51,52,53),ITETA WRITE(IOIMP,1001)ITETA KERRE=640 RETURN C C FISSURATION EN (Z) PUIS EN (@) C 51 DSIGPP(1)=DSIGPP(1)*GAMMA ITETA=3 GO TO 47 C C FISSURATION EN (Z) PUIS EN (R) C 52 DSIGPP(2)=DSIGPP(2)*GAMMA DSIGPP(3)=DSIGPP(3)*GAMMA ITETA=3 GO TO 37 C C FISSURATION EN (Z) PUIS EN (R@) C 53 DSIGPP(1)=DSIGPP(1)*GAMMA ITETA=4 IRZ=3 GO TO 47 C C********************* FISSURATION EN (RZ) PUIS EN (@) ***************** C 33 CRIT3=SIGEL(3)-R3 IF(CRIT3.LE.0.D0) GO TO 23 SIG0P(3)=SIG0P(3)-SIMER DSIGPP(3)=DSIGPP(3)+SIMER C GAMMA=GAMTT(SIG0P(3),DSIGPP(3),R3) IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA IF(GAMMA.GE.1.D0) GO TO 23 IF(GAMMA.LT.0.D0) GAMMA=0.D0 C C CORRECTION DES INCREMENTS DE CONTRAINTES C GO TO(61,62,63),IND WRITE(IOIMP,1000)IND KERRE=640 RETURN C C FISSURE EN (R) PUIS EN (@) C 61 DSIGPP(2)=DSIGPP(2)*GAMMA-(1.D0-GAMMA)*SIMER ITETA=2 GO TO 47 C C FISSURE EN (Z) PUIS EN (@) C 62 DSIGPP(1)=DSIGPP(1)*GAMMA-(1.D0-GAMMA)*SIMER ITETA=3 GO TO 47 C C FISSURE EN (RZ) PUIS EN (@) C 63 ITETA=4 47 DSIGPP(3)=DSIGPP(3)*GAMMA C DO 39 I=1,6 SIGEL(I)=SIG0P(I)+DSIGPP(I) DSIGP(I)=DSIGP(I)*(1.D0-GAMMA) 39 CONTINUE C C RETOUR DANS LES AXES C WW1(1)=SIGEL(1) WW1(2)=SIGEL(2) WW1(3)=SIGEL(4) C CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE) C ITETA=ITETA+3 IND1=0 IND2=0 IND3=0 IND=0 JTRAC=ITRAC SIMER=0.D0 GO TO 24 C C*********************************************************************** C********************** FISSURATION EN (R@) PUIS EN (Z) **************** C*********************************************************************** C 25 WW1(2)=ROTA(SIGEL,CC,SS,CS,2) CRIT=WW1(2)-R2 IF(CRIT.LE.0.D0) GO TO 23 205 SIG0P(2)=SIG0P(2)-SIMER DSIGPP(2)=DSIGPP(2)+SIMER IF(DSIGPP(2).EQ.0.D0) GO TO 23 GAMMA=(R2-SIG0P(2))/DSIGPP(2) IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA IF(GAMMA.GE.1.D0) GO TO 23 IF(GAMMA.LT.0.D0) GAMMA=0.D0 IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA DSIGPP(2)=DSIGPP(2)*GAMMA IF(ITETA.EQ.2) DSIGPP(3)=DSIGPP(3)*GAMMA-(1.D0-GAMMA)*SIMER 30 DO 44 I=1,6 SIGEL(I)=SIG0P(I)+DSIGPP(I) DSIGP(I)=DSIGP(I)*(1.D0-GAMMA) 44 CONTINUE C C RETOUR DANS LES AXES C WW1(1)=SIGEL(1) WW1(2)=SIGEL(2) WW1(3)=SIGEL(4) C CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE) C ITETA=ITETA+2 IND1=0 IND2=0 IND3=0 IND=0 IRZ=3 JTRAC=ITRAC SIMER=0.D0 GO TO 24 C C*********************************************************************** C*********************** FISSURATION EN (Z@) PUIS EN (R) *************** C*********************************************************************** C 26 WW1(1)=ROTA(SIGEL,CC,SS,CS,1) CRIT=WW1(1)-R1 IF(CRIT.LE.0.D0) GO TO 23 206 SIG0P(1)=SIG0P(1)-SIMER DSIGPP(1)=DSIGPP(1)+SIMER IF(DSIGPP(1).EQ.0.D0) GO TO 23 GAMMA=(R1-SIG0P(1))/DSIGPP(1) IF(GAMMA.GE.1.D0) GO TO 23 IF(GAMMA.LT.0.D0) GAMMA=0.D0 DSIGPP(1)=DSIGPP(1)*GAMMA IF(ITETA.EQ.2) DSIGPP(3)=DSIGPP(3)*GAMMA-(1.D0-GAMMA)*SIMER 37 DO 46 I=1,6 SIGEL(I)=SIG0P(I)+DSIGPP(I) DSIGP(I)=DSIGP(I)*(1.D0-GAMMA) 46 CONTINUE C C RETOUR DANS LES AXES C WW1(1)=SIGEL(1) WW1(2)=SIGEL(2) WW1(3)=SIGEL(4) C CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE) C ITETA=ITETA+1 IND1=0 IND2=0 IND3=0 IND=0 IRZ=3 JTRAC=ITRAC SIMER=0.D0 GO TO 24 C C*********************************************************************** C****************************** PAS DE COUPLAGE ************************ C*********************************************************************** C 23 ITENS=ITENRZ+ITENTE DO 9 III=1,6 SIGMAT(III)=SIGEL(III) 9 CONTINUE GO TO 300 C C*********************************************************************** C****************************** LES FISSURES SE FERMENT **************** C*********************************************************************** C 4 CONTINUE IF(IIMPI.EQ.9) WRITE(IOIMP,7002) (SIGMAT(I),I=1,6) DO 10 III=1,6 SIGEL(III)=SIGMAT(III) 10 CONTINUE C C*********************************************************************** C**** CALCUL DE LA QUANTITE DE CONTRAINTE A ECOULER AVEC LE CRITERE **** C* DE LA TRACTION AVANT D ARRIVER AU CRITERE DE DRUCKER PRAGER ECROUI * C*********************************************************************** C 300 IF(IBAB.EQ.1) GO TO 331 IF(ICTD.EQ.1) GO TO 332 CALL KRITER(5,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1, .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE) IF(CRIT.LE.0.D0) GO TO 331 C C RETOUR DANS LES AXES C WW1(1)=SIGMA(1) WW1(2)=SIGMA(2) WW1(3)=SIGMA(4) C CALL RETOUR(WW1,SIGMA,CC,SS,CS,LUNE) C DO 301 I=1,6 DSIGMA(I)=SIGMAT(I)-SIGMA(I) 301 CONTINUE C C CALCUL DE GAMMA CISAILLEMENT C GAMCIS=GAMDP(SIGMA,DSIGMA,ALFAD2,DPELA2,ICONCA, . PREC,RFSG,RFEP,RFPR) IF(IIMPI.EQ.9) WRITE(IOIMP,7013) (SIGMA(I),I=1,6) IF(IIMPI.EQ.9) WRITE(IOIMP,7014) (DSIGMA(I),I=1,6) IF(IIMPI.EQ.9) WRITE(IOIMP,7007) GAMCIS,CRIT IF(GAMCIS.GE.1.D0) GO TO 331 IF(GAMCIS.LT.0.D0) GAMCIS=0.D0 IF(GAMCIS.LT.RFPR*PREC) GAMCIS=0.D0 C C ON RECOMMENCE AVEC GAMCIS*DSIGP AU LIEU DE DSIGP C DO 302 I=1,6 SIGEL(I)=SIGEL0(I) DSIGP(I)=GAMCIS*DSIGP0(I) 302 CONTINUE R1=R10 R2=R20 R3=R30 TETAQ=TETAQ0 ITRAC=ITRAC0 ITETA=ITETA0 IRZ=IRZ0 ICTD=1 IF(GAMCIS.NE.0.D0) GO TO 96 ITENS=0 ITENRZ=0 ITENTE=0 GO TO 332 C C*********************************************************************** C**************************** LA SORTIE ******************************** C*********************************************************************** C 331 DO 303 I=1,6 SIGMA(I)=SIGEL(I) DSIGMA(I)=0.D0 DSIGP(I)=0.D0 303 CONTINUE GO TO 333 C 332 DO 304 I=1,6 SIGMA(I)=SIGEL(I) DSIGMA(I)=DSIGP0(I)*(1.D0-GAMCIS) SIGMAT(I)=SIGMA(I)+DSIGMA(I) DSIGP(I)=DSIGMA(I) 304 CONTINUE C 333 IF(IBAB.EQ.0) CALL KRITER(5,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS, .DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGEL,FSIG,CRIT, .KERRE) IF(IIMPI.EQ.9) . WRITE(IOIMP,7009) CRIT,R1,R2,R3,TETAQ,ICTD,ITRAC,ITENRZ, . ITENTE,ITENS IF(IIMPI.EQ.9) WRITE(IOIMP,7013) (SIGMA(I),I=1,6) IF(IIMPI.EQ.9) WRITE(IOIMP,7014) (DSIGMA(I),I=1,6) IF(IIMPI.EQ.9) WRITE(IOIMP,7002) (SIGMAT(I),I=1,6) IF(IIMPI.EQ.9) WRITE(IOIMP,7001) (SIGEL(I),I=1,6) IF(IIMPI.EQ.9) WRITE(IOIMP,7006) (DSIGP(I),I=1,6) C 1000 FORMAT(1X,'ERREUR DANS CRACK DANS LA VALEUR DE IND =',I4) 1001 FORMAT(1X,'ERREUR DANS CRACK DANS LA VALEUR DE ITETA =',I4) 1002 FORMAT(1X,'ERREUR DANS CRACK PAS DE CONVERGENCE ITER =',I4) 7000 FORMAT(1X,'ITRAC =',I4,1X,'ITENRZ=',I4,1X,'ITENTE=',I4,/, . 1X,'ITETA =',I4,1X,'IRZ =',I4,1X,'ITER =',I4) 7001 FORMAT(1X,'SIGEL =',6(1X,1PD12.5)) 7002 FORMAT(1X,'SIGMAT=',6(1X,1PD12.5)) 7003 FORMAT(1X,'SIG0P =',6(1X,1PD12.5)) 7004 FORMAT(1X,'DSIGPP=',6(1X,1PD12.5)) 7005 FORMAT(1X,'SIGTP =',6(1X,1PD12.5)) 7006 FORMAT(1X,'DSIGP =',6(1X,1PD12.5)) 7007 FORMAT(1X,'GAMCIS=',1PD12.5,1X,'CRIT =',1PD12.5) 7008 FORMAT(1X,'GAMMA =',1PD12.5) 7009 FORMAT(1X,'CRIT =',1PD12.5,1X,'R1 =',1PD12.5, . 1X,'R2 =',1PD12.5,/, . 1X,'R3 =',1PD12.5,1X,'TETAQ =',1PD12.5,/, . 1X,'ICTD =',I4,1X,'ITRAC =',I4,1X,'ITENRZ=',I4, . 1X,'ITENTE=',I4,1X,'ITENS =',I4) 7011 FORMAT(1X,'IND =',I4,1X,'IND1 =',I4, . 1X,'IND2 =',I4,1X,'IND3 =',I4) 7012 FORMAT(1X,'ITETA =',I4) 7013 FORMAT(1X,'SIGMA =',6(1X,1PD12.5)) 7014 FORMAT(1X,'DSIGMA=',6(1X,1PD12.5)) C RETURN END