C DECHIN    SOURCE    CHAT      05/01/12    22:39:09     5004           
C DECHIN     SOURCE    INSL       24/10/96    
      SUBROUTINE DECHIN(SIGRX,EPSRX,ETS,EDC,EPST,IFISU,JFISU,RTM,
     1 EPSC,DEFR,TANG,IPLA,EQSTR,EPSEQ,EX,RB,ALPHA,EPO1,EMAX,ICAL,
     2 IBB1,IGAU1,IDIR)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
C     CE SOUS-PROGRAMME CALCULE LA CONTRAINTE REELLE S1X ET INITIALISE
C     LES VARIABLES INTERNES LORSQU'IL Y A DECHARGE A PARTIR D'UN 
C     POINT INTEGRE. ON SE BRANCHE ALORS SUR LA COURBE 1-D CORRESPONDANT 
C     A ICU=3 (PARABOLE-SOFTENING LINEAIRE)
C                            
C     PF : POINT FOCAL
C     EPST : DEFORMATION EN COMPRESSION CORRESPONDANT A -RBT
C            APRES DECHARGE
C     EPSC : DEFORMATION EN COMPRESSION A L'INSTANT DE LA DECHARGE
C     RTMC : RESISTANCE EN TRACTION MODIFIEE si decharge en compression
C     RTM  : RESISTANCE EN TRACTION ACTUELLE
C     EDC  : PENTE DECHARGE EN COMPRESSION
C     DEFR : DEFORMATION RESIDUELLE APRES DECHARGE EN COMPRESSION
C     ETS  : PENTE EN TENSION-SOFTENING
C     TANG : PENTE ACTUELLE
C     IPLA : INDICATEUR DE PLASTICITE/ =0 comportement pre-pic en compression
C                                      =2 softening en compression
C                                      =4 rupture en compression (epsi>emax)
C
C------------------------------------------------------------------
      ZERO=0.D0
      UN=1.D0
      RBT=ALPHA*RB
      PF=RB/EX
      EPOC=-1.D0*EPO1
      IF(EPSRX.LT.(-1.D0*EMAX)) THEN
C        
C     ON SUPPOSE QUE LE POINT EST ROMPU EN COMPRESSION   
C        
        IPLA=4
        SIGRX =ZERO
        RTM =ZERO
        TANG=ZERO
        ETS =ZERO
        EQSTR=ZERO
        RETURN
      ENDIF     
C            
      IF(EPSRX .LE. EPOC) THEN
C**********************************************************************
C       POINT EN REGIME POST-PIC (COMPRESSION)
C**********************************************************************
       IPLA=2
       AA=-1.D0*RB/(EMAX-EPO1)
       BB=AA*EMAX
       DELTA=SIGRX-(AA*EPSRX+BB)
       IF(DELTA .GT. ZERO) THEN
C      
C       POINT EN DECHARGE A PARTIR DE LA COURBE DE COMPRESSION
C      
        CALL PARDEC(EPSRX,SIGRX,EPSC,EQSTR,EDC,IPLA,DEFR,RB,ALPHA,EPO1,
     &  EX,EMAX,ICAL)
        EPSEQ=DABS(EPSC)
        GOTO 100
       ELSE
C      
C       POINT EN CHARGE (SOFTENING)
C       COURBE DE COMPRESSION TRANSLATEE
C
        SEQ=DABS(SIGRX)
        IPLA=2  
        CALL EPSEQU(EPEQTR,SEQ,IPLA,ICAL,1,EX,RB,EPO1,EPO1,EMAX)
        SIGRX=-1.D0*SEQ
        EPSRX=-1.D0*EPEQTR      
        EQSTR=SEQ
        EPSEQ=EPEQTR
       ENDIF
      RETURN
      ENDIF
C**********************************************************************
C       POINT EN REGIME PRE-PIC (COMPRESSION)
C***********************************************************************
      DELTA=1.D0
      DEFRLI = EPSRX-SIGRX/EX
      IF(DABS(DEFRLI).LE.1.D-9) DEFRLI=0.D0
      IF(EPSRX.LE.ZERO) THEN
       EPEQ=DABS(EPSRX)
       CALL CDCY(EPEQ,SEQ2,IPL,TAN,EX,RB,EMAX,EPO1,ICAL)
       DELTA=-1.D0*SEQ2-SIGRX
      ENDIF
      IF(DELTA.LT.ZERO.OR.(DEFRLI.LT.ZERO.AND.EPSRX.GE.ZERO)) THEN
C      
C       POINT EN DECHARGE A PARTIR DE LA COURBE DE COMPRESSION
C      
        CALL PARDEC(EPSRX,SIGRX,EPSC,EQSTR,EDC,IPLA,DEFR,RB,ALPHA,EPO1,
     &  EX,EMAX,ICAL)
       EPSEQ=DABS(EPSC)
       GOTO 100
      ENDIF
C--------------------------------------------------------------
C       POINT CONSIDERE INITIALLEMENT TENDU
C--------------------------------------------------------------
      EPSF0=RTM/EX
      IF(EPSRX.GE.ZERO .AND. SIGRX.GE.ZERO) THEN
         IF(SIGRX.GE.RTM) THEN
           SIGRX=RTM
           IFISU=1
           JFISU=1
         ENDIF
         IF(EPSRX.GE.EPSF0) THEN
           EPSRX=EPSF0+(RTM-SIGRX)/ETS
           IFISU=1
           JFISU=1
         ELSE
           EPSRX=SIGRX/EX
         ENDIF
         RETURN
      ENDIF
C==============================================================
C       POINT INITIALLEMENT COMPRIME
C       COURBE DE COMPRESSION TRANSLATEE
C
      SEQ=DABS(SIGRX)
      IPLA=0  
      CALL EPSEQU(EPEQTR,SEQ,IPLA,ICAL,1,EX,RB,EPO1,EPO1,EMAX)
      SIGRX=-1.D0*SEQ
      EPSRX=-1.D0*EPEQTR      
      EQSTR=SEQ
      EPSEQ=EPEQTR
      RETURN
C==============================================================
  100 CONTINUE
C
C       RESISTANCE EN TRACTION MODIFIEE
C
      EPOC=-1.D0*EPO1
      IF(DABS(DEFR).LT.1.D-10) DEFR=0.D0
      IF(DEFR.LT.EPOC) THEN
        RTMC=0.D0
      ELSE
        AS2  = RBT/(EPO1+RBT/EX)
        IF(DABS(EDC-AS2).GT.1.D-5) THEN
          EPS1 = (EDC*DEFR-AS2*EPOC)/(EDC-AS2)
          RTMC = EDC*(EPS1-DEFR)
        ELSE
          RTMC = 0.D0
        ENDIF
C
        IF(RTMC.GT.RBT.AND.RTMC.LT.(1.00001D0*RBT)) RTMC = RBT
        IF(RTMC.GT.RBT.OR.RTMC.LT.0.D0) THEN
          WRITE(*,94) IBB1,IGAU1,IDIR
          WRITE(*,*) 'RTMC = ',RTMC, 'RBT = ',RBT
          WRITE(*,*) 'DEFR = ',DEFR,'EPO1 = ',EPO1
          WRITE(*,*) 'EPSRX= ',EPSRX,' SIGRX= ',SIGRX
          WRITE(*,*) 'EDC = ',EDC,' AS2 = ',AS2,' EPS1 = ',EPS1
          WRITE(*,*) 'ARRET ---> RTMC ?? !!! (SUBR DECHINT2) '
          RTMC=RBT
          STOP
        ENDIF
      ENDIF
      IF(RTMC .LT. ZERO) RTMC=ZERO
      IF(RTMC.LT.RTM) RTM=RTMC
C
C       CALCUL DE LA DEFORMATION CORRESPONDANT A -RBT
C
      IF(DABS(EDC).LT.1.D-5) EDC=EX
      EPST=DEFR-RBT/EDC
C
      IF(EDC.LT.0.D0) THEN
          WRITE(*,94) IBB1,IGAU1,IDIR
          WRITE(*,*) 'RTMC = ',RTMC, 'RBT = ',RBT
          WRITE(*,*) 'DEFR = ',DEFR,'EPO1 = ',EPO1
          WRITE(*,*) 'EPSRX= ',EPSRX,' SIGRX= ',SIGRX
          WRITE(*,*) 'EDC = ',EDC,' AS2 = ',AS2,' EPS1 = ',EPS1
          WRITE(*,*) 'ARRET ---> EDC<0  ?? !!! (SUBR DECHINT2) '
          STOP
      ENDIF
C
C     Dans le cas ou la decharge s'effectue dans la branche descendante
C     en-dessous du niveau |RBT| on m‚morise EPSC
C
      IF(IPLA .EQ. 2 .AND. EQSTR .LE. RBT) EPST=EPSC
C       
 94   FORMAT(' ELEME=',I3,'POINT=',I2,' IDIR=',I2)
      RETURN
      END