C T1T2      SOURCE    CHAT      05/01/13    03:29:41     5004
      SUBROUTINE T1T2(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,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),SG(3),DSG(3),EPC1(3),EPC2(3),SG1(3),
     1 DSG1(3),SG2(3),DSG2(3)
      Y=YOUN/(1.D0-ANU*ANU)
      IF(IIMPI.EQ.9) WRITE(IOIMP,9999)
9999  FORMAT(1X,'T1T2 COUPLAGE TRACTION 1 TRACTION 2 ',/)
      IF(RT1.LT.1.E-10) THEN
      H1=0.D0
      RT1=0.D0
      ENDIF
      IF(RT2.LT.1.E-10) THEN
      H2=0.D0
      RT2=0.D0
      ENDIF
      EPC1(1)=1.D0
      EPC2(2)=1.D0
      EPC2(1)=0.D0
      EPC1(2)=0.D0
      EPC2(3)=0.D0
      EPC1(3)=0.D0
C
C---------------------------------
C     COUPLAGE DES TRACTIONS
C---------------------------------
C
C-------------------------------------------------
C     ON SE PLACE DANS LE REPERE DE FISSURATION
C-------------------------------------------------
C
      CALL CHREP(SIG,SFG,ANG)
      CALL CHREP(DSIG,DSFG,ANG)
C
C------------------------------------------
C     OBTENTION DU SYSTEME EN DL1 DL2
C------------------------------------------
C
    1 B(1)=DSFG(1)+SFG(1)-RT1
      B(2)=DSFG(2)+SFG(2)-RT2
      A(1)=Y-H1
      A(4)=Y-H2
      A(2)=Y*ANU
      A(3)=A(2)
      CALL SYLIN2(A,B,DL1,DL2)
C
C-------------------------------------
C     CAS DES FAUX COUPLAGES
C-------------------------------------
C
      IF(DL1.LT.-1.E-10) IDAM(1)=0
      IF(DL2.LT.-1.E-10) IDAM(2)=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 1 DEPASSE 0
C-----------------------------------------------
C
      IF((RT1-H1*DL1).GE.-1.E-10) GOTO 1000
      DL1=RT1/H1
      B(1)=-SFG(1)+DL1*Y
      B(2)=RT2-SFG(2)+DL1*Y*ANU
      A(1)=DSFG(1)
      A(3)=DSFG(2)
      A(2)=-Y*ANU
      A(4)=-Y+H2
      CALL SYLIN2(A,B,X,DL2)
      EPC(1)=DL1
      EPC(2)=DL2
      EPC(3)=0.D0
      IF((RT2-H2*DL2).LT.0.D0) GOTO 1001
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      DO 10 ITYP=1,3
      SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP)
   10 DSFC(ITYP)=(1.D0-X)*DSFG(ITYP)
      CALL CDP(SFC,ADP,RDP,VCDP)
      IF(VCDP.GT.0.D0) GOTO 3000
      DO 20 ITYP=1,3
      SFG(ITYP)=SFC(ITYP)
   20 DSFG(ITYP)=DSFC(ITYP)
      XLAM1=XLAM1+DL1
      XLAM2=XLAM2+DL2
      RT1=0.D0
      H1=0.D0
      RT2=RT2-DL2*H2
      IF(RT2.LT.1.E-10) THEN
      H2=0.D0
      RT2=0.D0
      ENDIF
      GOTO 1
C
C-----------------------------------------------
C     CAS OU LA LIMITE EN TRACTION2 DEPASSE  0
C-----------------------------------------------
C
 1000 IF((RT2-H2*DL2).GE.-1.E-10) GOTO 2000
 1001 DL2=RT2/H2
      B(1)=RT1-SFG(1)+DL2*Y*ANU
      B(2)=-SFG(2)+DL2*Y
      A(1)=DSFG(1)
      A(3)=DSFG(2)
      A(4)=-Y*ANU
      A(2)=-Y+H1
      CALL SYLIN2(A,B,X,DL1)
      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)
 1010 DSFC(ITYP)=(1.D0-X)*DSFG(ITYP)
      CALL CDP(SFC,ADP,RDP,VCDP)
      IF(VCDP.GT.0.D0) GOTO 3000
      DO 1020 ITYP=1,3
      SFG(ITYP)=SFC(ITYP)
 1020 DSFG(ITYP)=DSFC(ITYP)
      XLAM1=XLAM1+DL1
      XLAM2=XLAM2+DL2
      RT2=0.D0
      H2=0.D0
      RT1=RT1-DL1*H1
      IF(RT1.LT.1.E-10) THEN
      H1=0.D0
      RT1=0.D0
      ENDIF
      GOTO 1
 2000 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)
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     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
      RT1=RT1-H1*DL1
      IF(RT1.LE.1.E-10) THEN
      H1=0.D0
      RT1=0.D0
      ENDIF
      RT2=RT2-H2*DL2
      IF(RT2.LE.1.E-10) THEN
      H2=0.D0
      RT2=0.D0
      ENDIF
      DO 2020 ITYP=1,3
 2020 DSIG(ITYP)=0.D0
      CALL CHREP(SFC,SIG,-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
      CALL CPHOOB(EPC1,SG1,YOUN,ANU)
      CALL CPHOOB(EPC2,SG2,YOUN,ANU)
      B(1)=SFG(1)-RT1
      B(2)=SFG(2)-RT2
      A(1)=Y-H1
      A(4)=Y-H2
      A(2)=ANU*Y
      A(3)=A(2)
      CALL SYLIN2(A,B,DL11,DL21)
      DO 3010 ITYP=1,3
3010  SG(ITYP)=SFG(ITYP)-DL11*SG1(ITYP)-DL21*SG2(ITYP)
      B(1)=DSFG(1)
      B(2)=DSFG(2)
      CALL SYLIN2(A,B,DL12,DL22)
      DO 3020 ITYP=1,3
3020  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
C
C------------------------------------------------
C     L ECOULEMENT SE FAIT PARTIELLEMENT
C     MISE A JOUR DES VARIABLES D ENDOMMAGEMENT
C     ET DE L INCREMENT DSIGMA
C------------------------------------------------
C
      IDAM(1)=1
      IDAM(2)=1
      IDAM(3)=1
      DL1=DL11+X*DL12
      DL2=DL21+X*DL22
      EPC(1)=DL1
      EPC(2)=DL2
      EPC(3)=0.D0
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      DO 3030 ITYP=1,3
      SFG(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
 3030 DSFG(ITYP)=(1.D0-X)*DSFG(ITYP)
      XLAM1=XLAM1+DL1
      XLAM2=XLAM2+DL2
      RT1=RT1-H1*DL1
      RT2=RT2-H2*DL2
      IF(RT1.LE.1.E-10) THEN
      H1=0.D0
      RT1=0.D0
      ENDIF
      IF(RT2.LE.1.E-10) THEN
      H2=0.D0
      RT2=0.D0
      ENDIF
      CALL CHREP(DSFG,DSIG,-ANG)
      CALL CHREP(SFG,SIG,-ANG)
      RETURN
      END