Esope source files

   1 : C DECHAC    SOURCE    CHAT      05/01/12    22:38:54     5004           
   2 : C  DECHAC    SOURCE    INSL       24/10/96    
   3 :       SUBROUTINE DECHAC(S1X,EDC,EPST,EDT,RTM,EPSC,DEFR,SIGRX,STRNX,
   4 :      1 STRNRX,EPSRX,IFISU,JFISU,SIGMRX,IPLA,TANG,PENT,EX,RB,ALPHA,
   5 :      2 EPO1,IBB1,IGAU1,IDIR,PASDC)
   6 : C
   7 :       IMPLICIT INTEGER(I-N)
   8 :       IMPLICIT REAL*8(A-H,O-Z)
   9 :       CHARACTER*8 PASDC
  10 : C
  11 : C     CE SOUS-PROGRAMME CALCULE LA CONTRAINTE REELLE S1X LORSQU'IL Y A
  12 : C     DECHARGE (ENDOMMAGEE) A PARTIR DE LA COURBE   :
  13 : C                            1 :  HYPER-SOFTENING (KRISHNAN)
  14 : C                            2 :  PARABOLE-RECTANGLE
  15 : C                            3 :  HYPERBOLE-RECTANGLE
  16 : C     PF : POINT FOCAL
  17 : C     EPST : DEFORMATION EN COMPRESSION CORRESPONDANT A -RBT
  18 : C            APRES DECHARGE
  19 : C     EPSC : DEFORMATION EN COMPRESSION A L'INSTANT DE LA DECHARGE
  20 : C     RTM  : RESISTANCE EN TRACTION MODIFIEE SI DECHARGE EN COMPRESSION
  21 : C     EDC  : PENTE DECHARGE EN COMPRESSION
  22 : C     EDT  : PENTE DECHARGE EN TRACTION ---> FERMETURE DE LA FISSURE
  23 : C            Remarque: on rerouve cette pente en compression lorsque
  24 : C            la deformation est superieur a EPST
  25 : C     DEFR : DEFORMATION RESIDUELLE APRES DECHARGE EN COMPRESSION
  26 : C====================================================================
  27 : C
  28 :       IF(DABS(EDC).LT.0.1D-5) EDC=0.D0
  29 :       IF(EDC.EQ.0.D0.OR.(EPSRX.LT.EPSC.AND.EPSC.NE.0.D0)) THEN
  30 : C
  31 : C       CALCULS DE EDC,DEFR,RTM,EPSC,EPST
  32 : C
  33 : C     DEUX CAS PEUVENT SE PRESENTER :  1- POINT INTEGRE
  34 : C                                      2- POINT DEJA FISSURE
  35 : C
  36 :       ZERO=0.D0
  37 :       TOL=1.D-10
  38 :       RBT=ALPHA*RB
  39 :       PF=RB/EX
  40 : C
  41 : C       PENTE ENDOMMAGEE
  42 : C
  43 :       SEQ=-1.D0*DABS(SIGRX)
  44 :       IF(DABS(EPSRX-PF).GT.1.D-5) THEN
  45 :         EDC=(SEQ-RB)/(EPSRX-PF)
  46 :       ELSE
  47 :         EDC=EX
  48 :       ENDIF
  49 :       IF(EDC.GT.EX.OR.DABS(EDC).LT.1.D-5) EDC=EX
  50 :       DEFR=RB*(1.D0/EX-1.D0/EDC)
  51 : C
  52 :       IF(DABS(DEFR).LT.TOL.AND.DABS(EPSRX).LT.TOL) THEN
  53 :        DEFR=ZERO
  54 :        EPSC=ZERO
  55 :        EQSTR=ZERO
  56 :        S1X=ZERO
  57 :        RETURN
  58 :       ENDIF
  59 : C      
  60 :       IF(EDC.LT.0.D0) THEN
  61 :        WRITE(*,*) ' !!!!  ATTENTION DANS DECHART EDC < 0 APPELE PAR'
  62 :      & ,PASDC   
  63 :        WRITE(*,94) IBB1,IGAU1,IDIR
  64 :        WRITE(*,*) 'EPST=',EPST,'EPSC =',EPSC,'EDT =',EDT
  65 :        WRITE(*,*) 'JFISU =',JFISU,' IFISU=',IFISU,' IPLA =',IPLA
  66 :        WRITE(*,*) 'EPSRX= ',EPSRX,' SIGRX= ',SIGRX,'DEFR =',DEFR
  67 :        WRITE(*,*) 'STRNRX= ',STRNRX,' SIGMRX= ',SIGMRX
  68 :        WRITE(*,*) 'EDC = ',EDC,' PF = ',PF,' RTM = ',RTM
  69 :        WRITE(*,*) 'ARRET ---> EDC<0 !!! (SUBR DECHARC) '
  70 :        STOP
  71 :       ENDIF
  72 : C
  73 : C       RESISTANCE EN TRACTION MODIFIEE
  74 : C
  75 :       EPOC=-1.D0*EPO1
  76 :       IF(DEFR.LT.EPOC) THEN
  77 :         RTMC=0.D0
  78 :       ELSE
  79 :         AS2  = RBT/(EPO1+RBT/EX)
  80 :         IF(DABS(EDC-AS2).GT.1.D-5) THEN
  81 :           EPS1 = (EDC*DEFR-AS2*EPOC)/(EDC-AS2)
  82 :           RTMC = EDC*(EPS1-DEFR)
  83 :         ELSE
  84 :           RTMC = 0.D0
  85 :         ENDIF
  86 : C
  87 :         IF(RTMC.GT.RBT.AND.RTMC.LT.(1.00001D0*RBT)) RTMC = RBT
  88 :         IF(RTMC.GT.RBT.OR.RTMC.LT.0.D0) THEN
  89 :         WRITE(*,*) ' !!!! ATTENTION DANS DECHART RTM > FT APPELE PAR'
  90 :      &   ,PASDC 
  91 :           WRITE(*,94) IBB1,IGAU1,IDIR
  92 :           WRITE(*,*) 'EPST=',EPST,'EPSC =',EPSC,'EDT =',EDT
  93 :           WRITE(*,*) 'JFISU =',JFISU,' IFISU=',IFISU,' IPLA =',IPLA
  94 :           WRITE(*,*) 'DEFR = ',DEFR,'EPO1 = ',EPO1
  95 :           WRITE(*,*) 'EPSRX= ',EPSRX,' SIGRX= ',SIGRX
  96 :           WRITE(*,*) 'STRNRX= ',STRNRX,' SIGMRX= ',SIGMRX
  97 :           WRITE(*,*) 'EDC = ',EDC,' AS2 = ',AS2,' EPS1 = ',EPS1
  98 :           WRITE(*,*) 'ARRET ---> RTMC ?? !!! (SUBR DECHARC) '
  99 :           RTMC=RBT
 100 :           STOP
 101 :         ENDIF
 102 :       ENDIF
 103 : C
 104 :       IF(RTMC.LT.0.D0) RTMC=0.D0
 105 :       IF(RTMC.LT.RTM) RTM=RTMC
 106 : C
 107 : C    MEMORISATION DE LA DEFORMATION A L'INSTANT DE LA DECHARGE (EPSC)
 108 : C
 109 :       EPSC=EPSRX
 110 : C
 111 : C       CALCUL DE LA DEFORMATION CORRESPONDANT A -RBT
 112 : C
 113 :       IF(DABS(EDC).LT.1.D-5) EDC=EX
 114 :       EPST=DEFR-RBT/EDC
 115 : C
 116 : C     Dans le cas ou la de‚charge s'effectue dans la branche descendante
 117 : C     en-dessous du niveau |RBT| on me‚morise EPSC
 118 : C
 119 :       IF(IPLA.EQ.2.AND.DABS(SIGRX).LE.RBT) EPST=EPSC
 120 :       ENDIF
 121 : C=======================================================================
 122 : C        CAS OU LE POINT A DEJA SUBIT UNE DECHARGE (EDC .NE. 0)
 123 : C=======================================================================
 124 : C
 125 : C  CALCUL DE LA CONTRAINTE REELLE
 126 : C   DECHARGE D'UN POINT INTEGRE OU DECHARGE D'UN POINT initiallement FISSURE
 127 : C   AVANT L'ATTEINTE DE LA PENTE EDT
 128 : C
 129 :       S1X=SIGRX+STRNX*EDC
 130 :       TANG=EDC
 131 :       IF(IPLA.EQ.2.AND.DABS(SIGRX).LE.RBT) GOTO 10
 132 : C
 133 : C       POINT INITIALLEMENT FISSURE
 134 : C
 135 :       IF(JFISU.EQ.1. AND. STRNRX .GT. EPST) THEN
 136 : C
 137 : C       ON EST SUR LA PENTE EDT
 138 : C
 139 :         S1X=-RBT+EDT*(STRNRX-EPST)
 140 :         TANG=EDT
 141 :       ENDIF
 142 :    10 CONTINUE
 143 :       IF(S1X.GE.RTM) THEN
 144 : C
 145 : C      1ere FISSURATION APRES DECHARGE EN COMPRESSION (TANG=EDC)
 146 : C       OU REOUVERTURE DE LA FISSURE (TANG=EDT)
 147 : C
 147 :        CALL FISSU2(S1X,SIGRX,STRNX,RTM,PENT,TANG)
 148 :        IFISU=1
 149 :        JFISU=1
 150 :       ENDIF
 151 :  94   FORMAT(' ELEME=',I3,'POINT=',I2,' IDIR=',I2)
 152 :       RETURN
 153 :       END
 154 :  
 155 :