Sources Esope | Cast3M

t1
C T1        SOURCE    CHAT      05/01/13    03:29:34     5004
      SUBROUTINE T1(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,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)
      Y=YOUN/(1.D0-ANU*ANU)
      IF(RT1.LT.1.E-10) THEN
      H1=0.D0
      RT1=0.D0
      ENDIF
C
C--------------------------------------------
C     BOITE D ECOULEMENT DE TRACTION 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,'T1 ECOULEMENT SUIVANT TRACTION 1',/)
    1 DL1=(SFG(1)+DSFG(1)-RT1)/(Y-H1)
      IF(DL1.LT.0.D0) THEN
      IDAM(1)=0
      RETURN
      ENDIF
C
C----------------------------------------------------------------
C     CAS OU LA LIMITE EN TRACTION RESTE SUPERIEURE A 0  (1000)
C----------------------------------------------------------------
C
      IF((RT1-H1*DL1).GE.-1.E-10) GOTO 1000
C
C--------------------------------------------------------
C     CAS OU LA LIMITE EN TRACTION DEVIENT NULLE
C--------------------------------------------------------
C
      DL1=RT1/H1
      EPC(1)=DL1
      EPC(2)=0.D0
      EPC(3)=0.D0
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      X=0.D0
      IF(DSFG(1).NE.0.D0) X=(SFC(1)-SFG(1))/DSFG(1)
      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)
      CALL CTRAF(SFC(2),RT2,VCTR2)
      CALL CCOAF(SFC(2),XLAM2,VCCO2)
      IF(VCTR2.GT.0.D0) GOTO 2000
      IF(VCCO2.GT.0.D0) GOTO 3000
      IF(VCDP.GT.0.D0) GOTO 4000
      RT1=0.D0
      H1=0.D0
      XLAM1=XLAM1+DL1
      DO 20 ITYP=1,3
      SFG(ITYP)=SFC(ITYP)
  20  DSFG(ITYP)=DSFC(ITYP)
      GOTO 1
1000  EPC(1)=DL1
      EPC(2)=0.D0
      EPC(3)=0.D0
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      DO 1010 ITYP=1,3
 1010 SFC(ITYP)=SFG(ITYP)+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(2),RT2,VCTR2)
      CALL CCOAF(SFC(2),XLAM2,VCCO2)
C
C------------------------------------
C     CRITERE DE TRACTION ENDOMMAGE
C------------------------------------
C
      IF(VCTR2.GT.0.D0) GOTO 2000
C
C----------------------------------------
C     CRITERE DE COMPRESSION ENDOMMAGE
C----------------------------------------
C
      IF(VCCO2.GT.0.D0) GOTO 3000
C
C------------------------------------
C     CRITERE DE DRUCKER ENDOMMAGE
C------------------------------------
C
      IF(VCDP.GT.0.D0) GOTO 4000
C
C--------------------------------------------------------
C     AUCUN AUTRE CRITERE ENDOMMAGE PENDANT L ECOULEMENT
C--------------------------------------------------------
C
      CALL CHREP(SFC,SIG,-ANG)
      DO 1020 ITYP=1,3
 1020 DSIG(ITYP)=0.D0
      RT1=RT1-H1*DL1
      IF(RT1.LE.1.E-10) THEN
      H1=0.D0
      RT1=0.D0
      ENDIF
      IDAM(1)=0
      IDAM(2)=0
      IDAM(3)=0
      XLAM1=XLAM1+DL1
      RETURN
C
C----------------------------------------
C     CAS OU EN ENDOMMAGE LA TRACTION2
C----------------------------------------
C
 2000 A(1)=DSFG(1)
      A(3)=DSFG(2)
      A(2)=-Y+H1
      A(4)=-Y*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)=RT2-SFG(2)
      CALL SYLIN2(A,B,X,DL1)
      EPC(1)=DL1
      EPC(2)=0.D0
      EPC(3)=0.D0
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      DO 2010 ITYP=1,3
      DSFC(ITYP)=(1.D0-X)*DSFG(ITYP)
 2010 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP)
      CALL CDP(SFC,ADP,RDP,VCDP)
      IF(VCDP.GT.0.D0) GOTO 4000
      RT1=RT1-H1*DL1
      IF(RT1.LE.1.E-10) THEN
      H1=0.D0
      RT1=0.D0
      ENDIF
      IDAM(1)=1
      IDAM(2)=1
      IDAM(3)=0
      XLAM1=XLAM1+DL1
      CALL CHREP(DSFC,DSIG,-ANG)
      CALL CHREP(SFC,SIG,-ANG)
      RETURN
C
C----------------------------------------
C     CAS OU EN ENDOMMAGE LA COMPRESSION 2
C----------------------------------------
C
 3000 A(1)=DSFG(1)
      A(3)=DSFG(2)
      A(2)=-Y+H1
      A(4)=-Y*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,DL1)
      EPC(1)=DL1
      EPC(2)=0.D0
      EPC(3)=0.D0
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      DO 3010 ITYP=1,3
      DSFC(ITYP)=(1.D0-X)*DSFG(ITYP)
 3010 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP)
      CALL CDP(SFC,ADP,RDP,VCDP)
      IF(VCDP.GT.0.D0) GOTO 4000
      RT1=RT1-H1*DL1
      IF(RT1.LE.1.E-10) THEN
      H1=0.D0
      RT1=0.D0
      ENDIF
      IDAM(1)=1
      IDAM(2)=-1
      IDAM(3)=0
      XLAM1=XLAM1+DL1
      CALL CHREP(DSFC,DSIG,-ANG)
      CALL CHREP(SFC,SIG,-ANG)
      RETURN
C
C----------------------------------------
C     CAS OU EN ENDOMMAGE LE DP
C----------------------------------------
C
 4000 CONTINUE
      EPC(1)=1.D0
      EPC(2)=0.D0
      EPC(3)=0.D0
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      E=Y-H1
      F=(SFG(1)-RT1)/E
      G=DSFG(1)/E
      DO 4010 ITYP=1,3
      SG(ITYP)=SFG(ITYP)-F*SFC(ITYP)
 4010 DSG(ITYP)=DSFG(ITYP)-G*SFC(ITYP)
      CALL XDP(SG,DSG,RDP,ADP,X,ITEST)
      IF(ITEST.EQ.1) THEN
      IDAM(1)=1
      IDAM(2)=0
      IDAM(3)=1
      RETURN
      ENDIF
      DL1=(SFG(1)+X*DSFG(1)-RT1)/(Y-H1)
      EPC(1)=DL1
      EPC(2)=0.D0
      EPC(3)=0.D0
      RT1=RT1-H1*DL1
      IF(RT1.LE.1.E-10) THEN
      H1=0.D0
      RT1=0.D0
      ENDIF
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      DO 4020 ITYP=1,3
      SFC(ITYP)=X*DSFG(ITYP)-SFC(ITYP)+SFG(ITYP)
 4020 DSFC(ITYP)=DSFG(ITYP)*(1.D0-X)
      XLAM1=XLAM1+DL1
      CALL CHREP(DSFC,DSIG,-ANG)
      CALL CHREP(SFC,SIG,-ANG)
      IDAM(1)=1
      IDAM(2)=0
      IDAM(3)=1
      RETURN
      END