C T2C1 SOURCE CHAT 05/01/13 03:29:51 5004 SUBROUTINE T2C1(SIG,DSIG,YOUN,ANU,RT2,H2,RDP,ADP, 1 XLAM1,XLAM2,IDAM,ANG) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO DIMENSION SIG(3),DSIG(3),SFC(3),DSFC(3),TSFC(3),SFG(3),DSFG(3), 1 EPC(3),A(4),B(2),IDAM(3),EPC1(3),EPC2(3),SG(3),DSG(3),SG1(3), 1 SG2(3),TENS(3) Y=YOUN/(1.D0-ANU*ANU) IF(RT2.LT.1.E-10) THEN H2=0.D0 RT2=0.D0 ENDIF C C------------------------------------------ C TRACTION DANS LA DIRECTION 2 | C COMPRESSION DANS LA DIRECTION 1 | C------------------------------------------ C C------------------------------------------------- C ON SE PLACE DANS LE REPERE DE FISSURATION | C------------------------------------------------- C CALL CHREP(SIG,SFG,ANG) CALL CHREP(DSIG,DSFG,ANG) IF(IIMPI.EQ.9) WRITE(IOIMP,9999) 9999 FORMAT(1X,'T2C1 COUPLAGE TRACTION 2 COMP 1',/) C C------------------------------------------ C OBTENTION DU SYSTEME EN DL1 DL2 C------------------------------------------ C 1 B(1)=DSFG(1)+SFG(1) B(2)=-RT2+DSFG(2)+SFG(2) A(1)=Y A(4)=Y-H2 A(2)=ANU*Y A(3)=A(2) CALL SYLIN2(A,B,DL1,DL2) C C----------------------------------------- C CAS DES FAUX COUPLAGES C----------------------------------------- C IF(DL2.LT.-1.E-10) IDAM(2)=0 IF(DL1.GT.1.E-10) IDAM(1)=0 IF(IDAM(1).EQ.0.OR.IDAM(2).EQ.0) THEN CALL CHREP(SFG,SIG,-ANG) CALL CHREP(DSFG,DSIG,-ANG) RETURN ENDIF C C----------------------------------------------- C CAS OU LA LIMITE EN TRACTION ATTEINT 0 | C----------------------------------------------- C IF((RT2-H2*DL2).GE.-1.E-10) GOTO 1000 DL2=RT2/H2 A(1)=DSFG(1) A(3)=DSFG(2) A(2)=-Y A(4)=-Y*ANU DET=A(1)*A(4)-A(2)*A(3) IF(DET.EQ.0.D0) THEN X=0.D0 DL1=(SFG(2)-Y*DL2)/Y/ANU IF(DL1.GT.0.D0) DL1=0.D0 GOTO 5 ENDIF B(1)=-SFG(1)+ANU*Y*DL2 B(2)=-SFG(2)+Y*DL2 CALL SYLIN2(A,B,X,DL1) 5 EPC(1)=DL1 EPC(2)=DL2 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 10 ITYP=1,3 DSFC(ITYP)=(1.D0-X)*DSFG(ITYP) 10 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP) IF(DL1.LT.-XLAM1) GOTO 1001 CALL CDP(SFC,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) GOTO 3000 RT2=0.D0 H2=0.D0 XLAM1=XLAM1+DL1 XLAM2=XLAM2+DL2 DO 20 ITYP=1,3 DSFG(ITYP)=DSFC(ITYP) 20 SFG(ITYP)=SFC(ITYP) GOTO 1 C C----------------------------------------------- C CAS OU ON FERME TOTALEMENT LA FISSURE 2 C----------------------------------------------- C 1000 IF(DL1.GE.-XLAM1) GOTO 2000 1001 DL1=-XLAM1 B(1)=-SFG(1)+DL1*Y B(2)=RT2-SFG(2)+DL1*ANU*Y A(2)=-Y*ANU A(1)=DSFG(1) A(4)=-Y+H2 A(3)=DSFG(2) DET=A(1)*A(4)-A(2)*A(3) IF(DET.EQ.0.D0) THEN X=0.D0 DL2=(SFG(2)-RT2-DL1*ANU*Y)/(Y-H2) IF(DL2.LT.0.D0) DL2=0.D0 GOTO 1005 ENDIF CALL SYLIN2(A,B,X,DL2) 1005 CONTINUE EPC(1)=DL1 EPC(2)=DL2 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 1010 ITYP=1,3 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP) DSFC(ITYP)=(1.D0-X)*DSFG(ITYP) 1010 TSFC(ITYP)=DSFG(ITYP)+SFG(ITYP) VCDP=-1.D0 IF(X.GT.1.E-10) CALL CDP(SFC,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) GOTO 3000 RT2=RT2-H2*DL2 IF(RT2.LE.1.E-10) THEN H2=0.D0 RT2=0.D0 ENDIF XLAM1=0.D0 XLAM2=XLAM2+DL2 IDAM(1)=0 GAMCO=10.D0 GAMTR=10.D0 GAMDP=10.D0 IDAM(2)=0 IDAM(3)=0 CALL CDP(TSFC,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) CALL GDP(SFC,DSFC,RDP,ADP,GAMDP) CALL CTRAF(TSFC(2),RT2,VCTR2) IF(VCTR2.GT.0.D0) CALL GAMTAF(SFC(2),DSFC(2),RT2,GAMTR) CALL CCOAF(TSFC(2),XLAM2,VCCO2) IF(VCCO2.GT.0.D0) CALL GAMCAF(SFC(2),DSFC(2),GAMCO) GAM=MIN(GAMDP,GAMTR,GAMCO) IF(GAM.GE.1.D0) THEN GAM=1.D0 GOTO 1020 ENDIF IF(ABS(GAM-GAMCO).LE.1.E-10) IDAM(2)=-1 IF(ABS(GAM-GAMTR).LE.1.E-10) IDAM(2)=1 IF(ABS(GAM-GAMDP).LE.1.E-10) IDAM(3)=1 1020 DO 1030 ITYP=1,3 SFG(ITYP)=SFC(ITYP)+GAM*DSFC(ITYP) 1030 DSFG(ITYP)=DSFC(ITYP)*(1.D0-GAM) CALL CHREP(SFG,SIG,-ANG) CALL CHREP(DSFG,DSIG,-ANG) RETURN 2000 CONTINUE EPC(1)=DL1 EPC(2)=DL2 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 2010 ITYP=1,3 2010 SFC(ITYP)=DSFG(ITYP)+SFG(ITYP)-SFC(ITYP) CALL CDP(SFC,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) GOTO 3000 C C------------------------------------------------ C ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE C PENDANT L 'ECOULEMENT (SINON 3000) C------------------------------------------------ C RT2=RT2-H2*DL2 IF(RT2.LE.1.E-10) THEN H2=0.D0 RT2=0.D0 ENDIF XLAM1=XLAM1+DL1 XLAM2=XLAM2+DL2 IDAM(1)=0 IDAM(2)=0 IDAM(3)=0 CALL CHREP(SFC,SIG,-ANG) DO 2020 ITYP=1,3 2020 DSIG(ITYP)=0.D0 RETURN 3000 CONTINUE EPC1(1)=1.D0 EPC1(2)=0.D0 EPC1(3)=0.D0 EPC2(2)=1.D0 EPC2(1)=0.D0 EPC2(3)=0.D0 CALL CPHOOB(EPC1,SG1,YOUN,ANU) CALL CPHOOB(EPC2,SG2,YOUN,ANU) B(1)=SFG(1) B(2)=SFG(2)-RT2 A(1)=Y A(4)=Y-H2 A(2)=ANU*Y A(3)=A(2) CALL SYLIN2(A,B,DL11,DL21) B(1)=DSFG(1) B(2)=DSFG(2) CALL SYLIN2(A,B,DL12,DL22) DO 3010 ITYP=1,3 SG(ITYP)=SFG(ITYP)-DL11*SG1(ITYP)-DL21*SG2(ITYP) 3010 DSG(ITYP)=DSFG(ITYP)-DL12*SG1(ITYP)-DL22*SG2(ITYP) CALL XDP(SG,DSG,RDP,ADP,X,ITEST) IF(ITEST.EQ.1) THEN IDAM(1)=-1 IDAM(2)=1 IDAM(3)=1 CALL CHREP(SFG,SIG,-ANG) CALL CHREP(DSFG,DSIG,-ANG) RETURN ENDIF DL1=DL11+X*DL12 DL2=DL21+X*DL22 IDAM(1)=-1 RT2=RT2-H2*DL2 IF(RT2.LE.1.E-10) THEN H2=0.D0 RT2=0.D0 ENDIF XLAM1=XLAM1+DL1 XLAM2=XLAM2+DL2 IDAM(1)=-1 IDAM(2)=1 IDAM(3)=1 IF(XLAM1.LT.1.E-8) THEN XLAM1=0.D0 IDAM(1)=0 ENDIF EPC(1)=DL1 EPC(2)=DL2 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 3020 ITYP=1,3 SFG(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP) 3020 DSFG(ITYP)=(1.D0-X)*DSFG(ITYP) CALL CHREP(DSFG,DSIG,-ANG) CALL CHREP(SFG,SIG,-ANG) RETURN END