C BONE3D    SOURCE    CHAT      05/01/12    21:42:02     5004
      SUBROUTINE BONE3D(SIG0,SIGF,DEPST,NSTRSS,BETINSA)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION SIG0(NSTRSS),SIGF(NSTRSS),DEPST(NSTRSS)
      DIMENSION DSIGE(6),D(6,6),SIGR(6)
C
      SEGMENT BETINSA
       REAL*8 RT,RC,YOUN,XNU,GFT,GFC,CAR
       REAL*8 DKT,DKC,SEQT,SEQC,ENDT,ENDC
       INTEGER IFIS,IPLA,IBB,IGAU
      ENDSEGMENT
C
C ***** CALCUL DU TIR ELASTIQUE ***************
C
C
C     COMPORTEMENT TRIDIMENSIONNEL
C
         CALL ZERO(D,6,6)
         E1=YOUN/(1.D0+XNU)/(1.D0-2.D0*XNU)
         D(1,1)=E1*(1.D0-XNU)
         D(1,2)=E1*XNU
         D(1,3)=D(1,2)
         D(2,1)=D(1,2)
         D(2,2)=D(1,1)
         D(2,3)=D(1,3)
         D(3,1)=D(1,2)
         D(3,2)=D(1,2)
         D(3,3)=D(1,1)
         D(4,4)=E1*(1.D0-2.D0*XNU)/2.D0
         D(5,5)=D(4,4)
         D(6,6)=D(5,5)
C
      DO 10 I=1,NSTRSS
      DSIGE(I)=0.D0
      DO 10 J=1,NSTRSS
      DSIGE(I)=DSIGE(I)+D(I,J)*DEPST(J)
   10 CONTINUE
C
      DO 15 I=1,NSTRSS
       SIGR(I)=SIG0(I)/((1.-ENDT)*(1.-ENDC))
   15 CONTINUE
C
      DO 30 I=1,NSTRSS
         SIGF(I)=SIGR(I)+DSIGE(I)
   30 CONTINUE
C
C ***** TEST DES CRITERES ACTIVES ***************
C
      CALL DRUTRA(SIGF,SEQTE,BETINSA)
      CALL DRUCOM(SIGF,SEQCE,BETINSA)
C
      FCRIT = SEQTE - SEQT
      FCRIC = SEQCE - SEQC
C
      IF(FCRIT.LT.0.D0.AND.FCRIC.LT.0.D0) IZON=0
      IF(FCRIT.GE.0.D0.AND.FCRIC.LT.0.D0) IZON=1
      IF(FCRIT.LT.0.D0.AND.FCRIC.GE.0.D0) IZON=2
      IF(FCRIT.GE.0.D0.AND.FCRIC.GE.0.D0) IZON=3
C
      IF(IZON.EQ.1) THEN
        CALL ACTI1(SIGR,SIGF,D,NSTRSS,BETINSA)
        CALL ENDAME(1,BETINSA)
             GOTO 100
      ENDIF
C
      IF(IZON.EQ.2) THEN
        CALL ACTI2(SIGR,SIGF,D,NSTRSS,BETINSA)
        CALL ENDAME(2,BETINSA)
             GOTO 100
      ENDIF
C
      IF(IZON.EQ.3) THEN
        CALL ACTI3(SIGR,SIGF,D,NSTRSS,BETINSA)
        CALL ENDAME(1,BETINSA)
        CALL ENDAME(2,BETINSA)
             GOTO 100
      ENDIF
C
  100 CONTINUE
C
      DO 150 I=1,NSTRSS
       SIGF(I)=SIGF(I)*((1.-ENDT)*(1.-ENDC))
  150 CONTINUE

      RETURN
      END




