C C1C2 SOURCE CHAT 05/01/12 21:44:44 5004 SUBROUTINE C1C2(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP, 1 XLAM1,XLAM2,IDAM,ANG) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -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) C C-------------------------------------------------------- C FERMETURE DES FISSURES DANS LES DEUX DIRECTIONS | C-------------------------------------------------------- C C------------------------------------------------- C ON SE PLACE DANS LE REPERE DE FISSURATION C------------------------------------------------- C IF(IIMPI.EQ.9) WRITE(IOIMP,9999) 9999 FORMAT(1X,'C1C2 COUPLAGE COMP 1 COMP 2',/) IC1=0 IC2=0 CALL CHREP(SIG,SFG,ANG) CALL CHREP(DSIG,DSFG,ANG) C C------------------------------------------ C OBTENTION DU SYSTEME EN DL1 DL2 C------------------------------------------ C B(1)=DSFG(1)+SFG(1) B(2)=DSFG(2)+SFG(2) A(1)=Y A(4)=Y A(2)=ANU*Y A(3)=A(2) CALL SYLIN2(A,B,DL1,DL2) C C----------------------------------------------- C CAS DES FAUX COUPLAGES DL1 OU DL2 POSITIF C----------------------------------------------- C IF(DL1.GT.1.E-10) IDAM(1)=0 IF(DL2.GT.1.E-10) IDAM(2)=0 IF(IDAM(1).EQ.0.OR.IDAM(2).EQ.0) RETURN IF(DL1.LT.-XLAM1) IC1=1 IF(DL2.LT.-XLAM2) IC2=1 C C----------------------------------------------- C CAS OU ON FERME TOTALEMENT LA FISSURE 1 C----------------------------------------------- C IF(DL1.LT.-XLAM1) GOTO 1000 C C----------------------------------------------- C CAS OU ON FERME TOTALEMENT LA FISSURE 2 C----------------------------------------------- C IF(DL2.LT.-XLAM2) GOTO 2000 C C------------------------------------ C ON EFFECTUE L ECOULEMENT C------------------------------------ C EPC(1)=DL1 EPC(2)=DL2 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 10 ITYP=1,3 10 TSFC(ITYP)=DSFG(ITYP)+SFG(ITYP)-SFC(ITYP) C C------------------------------------------------ C ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE C PENDANT L 'ECOULEMENT (SINON 3000) C------------------------------------------------ C CALL CDP(TSFC,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) GOTO 3000 C C------------------------------------------------ C CAS OU L ECOULEMENT SE FAIT ENTIEREMENT C MISE A JOUR DES VARIABLES D ENDOMMAGEMENT C------------------------------------------------ C XLAM1=XLAM1+DL1 XLAM2=XLAM2+DL2 IDAM(1)=0 IDAM(2)=0 IDAM(3)=0 DO 20 ITYP=1,3 20 DSIG(ITYP)=0.D0 CALL CHREP(TSFC,SIG,-ANG) RETURN C C------------------------------------------------ C CAS OU LA FISSURE1 EST COMPLETEMENT FERMEE C------------------------------------------------ C C------------------------------------------ C OBTENTION DU SYSTEME EN X DL2 C------------------------------------------ C 1000 DL1=-XLAM1 B(1)=-SFG(1)+DL1*Y B(2)=-SFG(2)+DL1*ANU*Y A(4)=-Y A(1)=DSFG(1) A(2)=-ANU*Y A(3)=DSFG(2) DET=A(1)*A(4)-A(2)*A(3) IF(DET.EQ.0.D0.AND.DL2.LT.-XLAM2) GOTO 2000 IF(DET.EQ.0.D0) GOTO 2500 CALL SYLIN2(A,B,X,DL2) IF(DL2.LT.-XLAM2) GOTO 2000 EPC(1)=DL1 EPC(2)=DL2 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 30 ITYP=1,3 30 SFC(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP) C C------------------------------------------------ C ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE C PENDANT L 'ECOULEMENT (SINON 3000) C------------------------------------------------ C CALL CDP(SFC,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) GOTO 3000 C C------------------------------------------------ C L ECOULEMENT SE FAIT PARTIELLEMENT C MISE A JOUR DES VARIABLES D ENDOMMAGEMENT C ET DE L INCREMENT DSIGMA C------------------------------------------------ C XLAM1=0.D0 XLAM2=XLAM2+DL2 DO 40 ITYP=1,3 DSFG(ITYP)=(1.D0-X)*DSFG(ITYP) 40 TENS(ITYP)=SFC(ITYP)+DSFG(ITYP) GOTO 2750 C C------------------------------------------------ C CAS OU LA FISSURE2 EST COMPLETEMENT FERMEE C------------------------------------------------ C C------------------------------------------ C OBTENTION DU SYSTEME EN X DL1 C------------------------------------------ C 2000 DL2=-XLAM2 B(1)=-SFG(1)+DL2*ANU*Y B(2)=-SFG(2)+DL2*Y A(2)=-Y A(1)=DSFG(1) A(4)=-ANU*Y A(3)=DSFG(2) DET=A(1)*A(4)-A(2)*A(3) IF(DET.EQ.0.D0) GOTO 2500 CALL SYLIN2(A,B,X,DL1) IF(DL1.LT.-XLAM1) GOTO 2500 EPC(1)=DL1 EPC(2)=DL2 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 130 ITYP=1,3 130 SFC(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP) C C------------------------------------------------ C ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE C PENDANT L 'ECOULEMENT (SINON 3000) C------------------------------------------------ C CALL CDP(SFC,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) GOTO 3000 C C------------------------------------------------ C L ECOULEMENT SE FAIT PARTIELLEMENT C MISE A JOUR DES VARIABLES D ENDOMMAGEMENT C ET DE L INCREMENT DSIGMA C------------------------------------------------ C XLAM2=0.D0 XLAM1=XLAM1+DL1 DO 140 ITYP=1,3 DSFG(ITYP)=(1.D0-X)*DSFG(ITYP) 140 TENS(ITYP)=SFC(ITYP)+DSFG(ITYP) GOTO 2750 2500 IF(IC1.EQ.1.AND.IC2.EQ.1) THEN DL1=-XLAM1 DL2=-XLAM2 XLAM1=0.D0 XLAM2=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 150 ITYP=1,3 SFC(ITYP)=SFG(ITYP)-SFC(ITYP) 150 TENS(ITYP)=SFC(ITYP)+DSFG(ITYP) GOTO 2750 ENDIF IF(IC1.EQ.1) THEN DL1=-XLAM1 XLAM1=0.D0 DL2=SFG(2)/Y-ANU*DL1 IF(DL2.GT.0.D0) DL2=0.D0 IF(DL2.LT.-XLAM2) DL2=-XLAM2 XLAM2=XLAM2+DL2 EPC(1)=DL1 EPC(2)=DL2 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 153 ITYP=1,3 SFC(ITYP)=SFG(ITYP)-SFC(ITYP) 153 TENS(ITYP)=DSFG(ITYP)+SFC(ITYP) GOTO 2750 ENDIF IF(IC2.EQ.1) THEN DL2=-XLAM2 XLAM2=0.D0 DL1=SFG(1)/Y-ANU*DL2 IF(DL1.GT.0.D0) DL1=0.D0 IF(DL1.LT.-XLAM1) DL1=-XLAM1 XLAM1=XLAM1+DL1 EPC(1)=DL1 EPC(2)=DL2 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 155 ITYP=1,3 SFC(ITYP)=SFG(ITYP)-SFC(ITYP) 155 TENS(ITYP)=DSFG(ITYP)+SFC(ITYP) ENDIF 2750 IDAM(1)=0 IDAM(2)=0 IDAM(3)=0 GAMDP=10.D0 GAMTR1=10.D0 GAMTR2=10.D0 GAMCO1=10.D0 GAMCO2=10.D0 CALL CDP(TENS,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) CALL GDP(SFC,DSFG,RDP,ADP,GAMDP) CALL CTRAF(TENS(1),RT1,VCTR1) IF(VCTR1.GT.0.D0) CALL GAMTAF(SFC(1),DSFG(1),RT1,GAMTR1) CALL CCOAF(TENS(1),XLAM1,VCCO1) IF(VCCO1.GT.0.D0) CALL GAMCAF(SFC(1),DSFG(1),GAMCO1) CALL CTRAF(TENS(2),RT2,VCTR2) IF(VCTR1.GT.0.D0) CALL GAMTAF(SFC(2),DSFG(2),RT2,GAMTR2) CALL CCOAF(TENS(2),XLAM2,VCCO2) IF(VCCO2.GT.0.D0) CALL GAMCAF(SFC(2),DSFG(2),GAMCO2) GAM=MIN(GAMCO1,GAMDP,GAMTR1,GAMTR2,GAMCO2) IF(GAM.GE.1.D0) THEN DO 156 ITYP=1,3 SFG(ITYP)=SFC(ITYP)+DSFG(ITYP) 156 DSIG(ITYP)=0.D0 CALL CHREP(SFG,SIG,-ANG) RETURN ENDIF IF(ABS(GAM-GAMCO1).LT.1E-10) IDAM(1)=-1 IF(ABS(GAM-GAMTR1).LT.1E-10) IDAM(1)=1 IF(ABS(GAM-GAMCO2).LT.1E-10) IDAM(2)=-1 IF(ABS(GAM-GAMTR2).LT.1E-10) IDAM(2)=1 IF(ABS(GAM-GAMDP).LT.1E-10) IDAM(3)=1 DO 157 ITYP=1,3 SFG(ITYP)=SFC(ITYP)+GAM*DSFG(ITYP) 157 DSFG(ITYP)=DSFG(ITYP)*(1.D0-GAM) CALL CHREP(SFG,SIG,-ANG) CALL CHREP(DSFG,DSIG,-ANG) RETURN C C----------------------------------------------------- C CAS OU ON ENDOMMAGE LE DP PENDANT L ECOULEMENT C CALCUL DE X POUR ARRIVER SUR LE CRITERE C----------------------------------------------------- C 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) A(4)=Y A(1)=A(4) A(2)=A(4)*ANU 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 RETURN ENDIF DL1=DL11+X*DL12 DL2=DL21+X*DL22 C C------------------------------------------------ C L ECOULEMENT SE FAIT PARTIELLEMENT C MISE A JOUR DES VARIABLES D ENDOMMAGEMENT C ET DE L INCREMENT DSIGMA C------------------------------------------------ C 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 IF(XLAM2.LT.1.E-8) THEN XLAM2=0.D0 IDAM(2)=0 ENDIF EPC(1)=DL1 EPC(2)=DL2 EPC(3)=0.D0 CALL CPHOOB(EPC,SFC,YOUN,ANU) DO 50 ITYP=1,3 SFG(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP) 50 DSFG(ITYP)=(1.D0-X)*DSFG(ITYP) CALL CHREP(DSFG,DSIG,-ANG) CALL CHREP(SFG,SIG,-ANG) RETURN END