Sources Esope | Cast3M

dechac
C DECHAC    SOURCE    CB215821  16/04/21    21:16:19     8920
C  DECHAC    SOURCE    INSL       24/10/96
      SUBROUTINE DECHAC(S1X,EDC,EPST,EDT,RTM,EPSC,DEFR,SIGRX,STRNX,
     1 STRNRX,EPSRX,IFISU,JFISU,SIGMRX,IPLA,TANG,PENT,EX,RB,ALPHA,
     2 EPO1,IBB1,IGAU1,IDIR,PASDC)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      CHARACTER*8 PASDC
C
C     CE SOUS-PROGRAMME CALCULE LA CONTRAINTE REELLE S1X LORSQU'IL Y A
C     DECHARGE (ENDOMMAGEE) A PARTIR DE LA COURBE   :
C                            1 :  HYPER-SOFTENING (KRISHNAN)
C                            2 :  PARABOLE-RECTANGLE
C                            3 :  HYPERBOLE-RECTANGLE
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     RTM  : RESISTANCE EN TRACTION MODIFIEE SI DECHARGE EN COMPRESSION
C     EDC  : PENTE DECHARGE EN COMPRESSION
C     EDT  : PENTE DECHARGE EN TRACTION ---> FERMETURE DE LA FISSURE
C            Remarque: on rerouve cette pente en compression lorsque
C            la deformation est superieur a EPST
C     DEFR : DEFORMATION RESIDUELLE APRES DECHARGE EN COMPRESSION
C====================================================================
C
      IF(ABS(EDC).LT.0.1D-5) EDC=0.D0
      IF(EDC.EQ.0.D0.OR.(EPSRX.LT.EPSC.AND.EPSC.NE.0.D0)) THEN
C
C       CALCULS DE EDC,DEFR,RTM,EPSC,EPST
C
C     DEUX CAS PEUVENT SE PRESENTER :  1- POINT INTEGRE
C                                      2- POINT DEJA FISSURE
C
      ZERO=0.D0
      TOL=1.D-10
      RBT=ALPHA*RB
      PF=RB/EX
C
C       PENTE ENDOMMAGEE
C
      SEQ=-1.D0*ABS(SIGRX)
      IF(ABS(EPSRX-PF).GT.1.D-5) THEN
        EDC=(SEQ-RB)/(EPSRX-PF)
      ELSE
        EDC=EX
      ENDIF
      IF(EDC.GT.EX.OR.ABS(EDC).LT.1.D-5) EDC=EX
      DEFR=RB*(1.D0/EX-1.D0/EDC)
C
      IF(ABS(DEFR).LT.TOL.AND.ABS(EPSRX).LT.TOL) THEN
       DEFR=ZERO
       EPSC=ZERO
       EQSTR=ZERO
       S1X=ZERO
       RETURN
      ENDIF
C
      IF(EDC.LT.0.D0) THEN
       WRITE(*,*) ' !!!!  ATTENTION DANS DECHART EDC &lt; 0 APPELE PAR'
     & ,PASDC
       WRITE(*,94) IBB1,IGAU1,IDIR
       WRITE(*,*) 'EPST=',EPST,'EPSC =',EPSC,'EDT =',EDT
       WRITE(*,*) 'JFISU =',JFISU,' IFISU=',IFISU,' IPLA =',IPLA
       WRITE(*,*) 'EPSRX= ',EPSRX,' SIGRX= ',SIGRX,'DEFR =',DEFR
       WRITE(*,*) 'STRNRX= ',STRNRX,' SIGMRX= ',SIGMRX
       WRITE(*,*) 'EDC = ',EDC,' PF = ',PF,' RTM = ',RTM
       WRITE(*,*) 'ARRET ---> EDC&lt;0 !!! (SUBR DECHARC) '
       STOP
      ENDIF
C
C       RESISTANCE EN TRACTION MODIFIEE
C
      EPOC=-1.D0*EPO1
      IF(DEFR.LT.EPOC) THEN
        RTMC=0.D0
      ELSE
        AS2  = RBT/(EPO1+RBT/EX)
        IF(ABS(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(*,*) ' !!!! ATTENTION DANS DECHART RTM > FT APPELE PAR'
     &   ,PASDC
          WRITE(*,94) IBB1,IGAU1,IDIR
          WRITE(*,*) 'EPST=',EPST,'EPSC =',EPSC,'EDT =',EDT
          WRITE(*,*) 'JFISU =',JFISU,' IFISU=',IFISU,' IPLA =',IPLA
          WRITE(*,*) 'DEFR = ',DEFR,'EPO1 = ',EPO1
          WRITE(*,*) 'EPSRX= ',EPSRX,' SIGRX= ',SIGRX
          WRITE(*,*) 'STRNRX= ',STRNRX,' SIGMRX= ',SIGMRX
          WRITE(*,*) 'EDC = ',EDC,' AS2 = ',AS2,' EPS1 = ',EPS1
          WRITE(*,*) 'ARRET ---> RTMC ?? !!! (SUBR DECHARC) '
          RTMC=RBT
          STOP
        ENDIF
      ENDIF
C
      IF(RTMC.LT.0.D0) RTMC=0.D0
      IF(RTMC.LT.RTM) RTM=RTMC
C
C    MEMORISATION DE LA DEFORMATION A L'INSTANT DE LA DECHARGE (EPSC)
C
      EPSC=EPSRX
C
C       CALCUL DE LA DEFORMATION CORRESPONDANT A -RBT
C
      IF(ABS(EDC).LT.1.D-5) EDC=EX
      EPST=DEFR-RBT/EDC
C
C     Dans le cas ou la decharge s'effectue dans la branche descendante
C     en-dessous du niveau |RBT| on memorise EPSC
C
      IF(IPLA.EQ.2.AND.ABS(SIGRX).LE.RBT) EPST=EPSC
      ENDIF
C=======================================================================
C        CAS OU LE POINT A DEJA SUBIT UNE DECHARGE (EDC .NE. 0)
C=======================================================================
C
C  CALCUL DE LA CONTRAINTE REELLE
C   DECHARGE D'UN POINT INTEGRE OU DECHARGE D'UN POINT initiallement FISSURE
C   AVANT L'ATTEINTE DE LA PENTE EDT
C
      S1X=SIGRX+STRNX*EDC
      TANG=EDC
      IF(IPLA.EQ.2.AND.ABS(SIGRX).LE.RBT) GOTO 10
C
C       POINT INITIALLEMENT FISSURE
C
      IF(JFISU.EQ.1. AND. STRNRX .GT. EPST) THEN
C
C       ON EST SUR LA PENTE EDT
C
        S1X=-RBT+EDT*(STRNRX-EPST)
        TANG=EDT
      ENDIF
   10 CONTINUE
      IF(S1X.GE.RTM) THEN
C
C      1ere FISSURATION APRES DECHARGE EN COMPRESSION (TANG=EDC)
C       OU REOUVERTURE DE LA FISSURE (TANG=EDT)
C
       CALL FISSU2(S1X,SIGRX,STRNX,RTM,PENT,TANG)
       IFISU=1
       JFISU=1
      ENDIF
 94   FORMAT(' ELEME=',I3,'POINT=',I2,' IDIR=',I2)
      RETURN
      END