C C2 SOURCE CHAT 05/01/12 21:45:04 5004 SUBROUTINE C2(SIG,DSIG,YOUN,ANU,RT1,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 A(4),B(2),IDAM(3),EPC(3),SG(3),DSG(3) Y=YOUN/(1.D0-ANU*ANU) C C-------------------------------------------- C BOITE D ECOULEMENT DE COMPRESSION C-------------------------------------------- C C----------------------------------------------- C ON SE PLACE DANS LE REPERE DE FISSURATION C----------------------------------------------- C IF(IIMPI.EQ.9) WRITE(IOIMP,9999) 9999 FORMAT(1X,'C2 ECOULEMENT SUIVANT COMP 2',/) CALL CHREP(SIG,SFG,ANG) CALL CHREP(DSIG,DSFG,ANG) DL2=(SFG(2)+DSFG(2))/Y C C------------------------------------------ C CAS OU LA FISSURE RESTE OUVERTE C TOUT LE TEMPS DE L ECOULEMENT (1000) C------------------------------------------- C IF(DL2.GT.0.D0) THEN IDAM(2)=0 RETURN ENDIF IF(DL2.GE.-XLAM2) THEN EPC(2)=DL2 EPC(1)=0.D0 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) X=1.D0 GOTO 1000 ENDIF C C------------------------------------------- C CAS OU LA FISSURE EST FERME AVANT C LA FIN DE L ECOULEMENT C------------------------------------------- C DL2=-XLAM2 EPC(2)=DL2 EPC(1)=0.D0 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) C C------------------------------------------ C ON CALCULE LA PARTIE DE DSIGMA C QU IL FAUT POUR FERMER LA FISSURE C------------------------------------------ C IF(DSFG(2).EQ.0.D0) THEN X=0.D0 DO 10 ITYP=1,3 DSFC(ITYP)=DSFG(ITYP) 10 SFC(ITYP)=SFG(ITYP)-SFC(ITYP) XLAM2=0.D0 DL2=0.D0 GOTO 1010 ENDIF X=(-SFG(2)+SFC(2))/DSFG(2) IF(X.LT.0.D0) THEN X=0.D0 DO 15 ITYP=1,3 DSFC(ITYP)=DSFG(ITYP) 15 SFC(ITYP)=SFG(ITYP)-SFC(ITYP) XLAM2=0.D0 DL2=0.D0 GOTO 1010 ENDIF 1000 DO 20 ITYP=1,3 DSFC(ITYP)=(1.D0-X)*DSFG(ITYP) 20 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP) C C----------------------------------------------- C ON REGARDE SI LES AUTRES CRITERES NE C SONT PAS ENDOMMAGES PENDANT L ECOULEMENT C----------------------------------------------- C CALL CDP(SFC,ADP,RDP,VCDP) CALL CTRAF(SFC(1),RT1,VCTR1) CALL CCOAF(SFC(1),XLAM1,VCCO1) C C------------------------------------ C CRITERE DE TRACTION ENDOMMAGE C------------------------------------ C IF(VCTR1.GT.0.D0) GOTO 2000 C C---------------------------------------- C CRITERE DE COMPRESSION ENDOMMAGE C---------------------------------------- C IF(VCCO1.GT.0.D0) GOTO 3000 C C------------------------------------ C CRITERE DE TRACTION ENDOMMAGE C------------------------------------ C IF(VCDP.GT.0.D0) GOTO 4000 C C--------------------------------------------------- C AUCUN CRITERE ENDOMMAGE PENDANT L ECOULEMENT C--------------------------------------------------- C 1010 DO 30 ITYP=1,3 30 TSFC(ITYP)=DSFC(ITYP)+SFC(ITYP) C C--------------------------------------------------- C ON REGARDE SI L ECOULEMENT RESTANT N ENDOMMAGE C PAS LES CRITERES C--------------------------------------------------- C IDAM(1)=0 IDAM(2)=0 IDAM(3)=0 C=1.D0-1.D-10 IF(X.GE.C) THEN GAM=1.D0 GOTO 1500 ENDIF GAMDP=10.D0 GAMCO1=10.D0 GAMTR1=10.D0 CALL CDP(TSFC,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) CALL GDP(SFC,DSFC,RDP,ADP,GAMDP) CALL CTRAF(TSFC(1),RT1,VCTR1) IF(VCTR1.GT.0.D0) CALL GAMTAF(SFC(1),DSFC(1),RT1,GAMTR1) CALL CCOAF(TSFC(1),XLAM1,VCCO1) IF(VCCO1.GT.0.D0) CALL GAMCAF(SFC(1),DSFC(1),GAMCO1) GAM=MIN(GAMTR1,GAMCO1,GAMDP) IF(GAM.GE.C) THEN GAM=1.D0 GOTO 1500 ENDIF IF(ABS(GAMCO1-GAM).LT.1.E-10) IDAM(1)=-1 IF(ABS(GAMTR1-GAM).LT.1.E-10) IDAM(1)=1 IF(ABS(GAMDP-GAM).LT.1.E-10) IDAM(3)=1 XLAM2=0.D0 DL2=0.D0 1500 DO 40 ITYP=1,3 SFG(ITYP)=SFC(ITYP)+GAM*DSFC(ITYP) 40 DSFG(ITYP)=(1.D0-GAM)*DSFC(ITYP) CALL CHREP(SFG,SIG,-ANG) CALL CHREP(DSFG,DSIG,-ANG) XLAM2=XLAM2+DL2 RETURN C C---------------------------------------- C CAS OU EN ENDOMMAGE LA TRACTION1 C PENDANT LA FERMETURE DE LA FISSURE C---------------------------------------- C 2000 A(1)=DSFG(1) A(3)=DSFG(2) A(4)=-Y A(2)=A(4)*ANU DET=A(1)*A(4)-A(2)*A(3) IF(DET.EQ.0.D0) THEN IDAM(1)=1 IDAM(2)=-1 IDAM(3)=0 RETURN ENDIF B(1)=RT1-SFG(1) B(2)=-SFG(2) CALL SYLIN2(A,B,X,DL2) EPC(2)=DL2 EPC(1)=0.D0 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 50 ITYP=1,3 DSFC(ITYP)=(1.D0-X)*DSFG(ITYP) 50 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP) CALL CDP(SFC,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) GOTO 4000 IDAM(2)=-1 IDAM(1)=1 IDAM(3)=0 XLAM2=XLAM2+DL2 CALL CHREP(DSFC,DSIG,-ANG) CALL CHREP(SFC,SIG,-ANG) RETURN C C---------------------------------------- C CAS OU EN ENDOMMAGE LA COMPRESSION1 C PENDANT LA FERMETURE DE LA FISSURE C---------------------------------------- C 3000 A(1)=DSFG(1) A(3)=DSFG(2) A(4)=-Y A(2)=A(4)*ANU DET=A(1)*A(4)-A(2)*A(3) IF(DET.EQ.0.D0) THEN IDAM(1)=-1 IDAM(2)=-1 IDAM(3)=0 RETURN ENDIF B(1)=-SFG(1) B(2)=-SFG(2) CALL SYLIN2(A,B,X,DL2) EPC(2)=DL2 EPC(1)=0.D0 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 150 ITYP=1,3 DSFC(ITYP)=(1.D0-X)*DSFG(ITYP) 150 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP) CALL CDP(SFC,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) GOTO 4000 IDAM(1)=-1 IDAM(2)=-1 IDAM(3)=0 XLAM2=XLAM2+DL2 CALL CHREP(DSFC,DSIG,-ANG) CALL CHREP(SFC,SIG,-ANG) RETURN C C---------------------------------------- C CAS OU EN ENDOMMAGE LE DP C PENDANT LA FERMETURE DE LA FISSURE C---------------------------------------- C 4000 CONTINUE EPC(1)=0.D0 EPC(2)=1.D0 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) E=Y F=SFG(2)/E G=DSFG(2)/E DO 70 ITYP=1,3 SG(ITYP)=SFG(ITYP)-F*SFC(ITYP) 70 DSG(ITYP)=DSFG(ITYP)-G*SFC(ITYP) CALL XDP(SG,DSG,RDP,ADP,X,ITEST) IF(ITEST.EQ.1) THEN IDAM(1)=0 IDAM(2)=-1 IDAM(3)=1 RETURN ENDIF DL2=(SFG(2)+X*DSFG(2))/Y EPC(1)=0.D0 EPC(2)=DL2 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 60 ITYP=1,3 SFG(ITYP)=X*DSFG(ITYP)-SFC(ITYP)+SFG(ITYP) 60 DSFG(ITYP)=DSFG(ITYP)*(1.D0-X) XLAM2=XLAM2+DL2 CALL CHREP(DSFG,DSIG,-ANG) CALL CHREP(SFG,SIG,-ANG) IDAM(1)=0 IDAM(2)=-1 IDAM(3)=1 RETURN END