Sources Esope | Cast3M

unicou
C UNICOU    SOURCE    CHAT      05/01/13    03:58:33     5004
      SUBROUTINE UNICOU(DK,PAEC,IC,SEQ,BETJEF)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
*
      SEGMENT BETJEF
       REAL*8 AA,BETA,RB,ALPHA,YOUN,XNU,GFC,GFT,HC,ETA,TDEF,
     &          TCON,DPSTF1,DPSTF2,TETA,PDT,TP0
       INTEGER ICC1,ICC2,IMOD,IVIS,ITER,
     &                ISIM,IBB,IGAU,IZON
      ENDSEGMENT
*
*     COMMON /DBETJEF/AA,BETA,RB,ALPHA,YOUN,XNU,GFC,GFT,HC,ETA,TDEF,
*    &        TCON,DPSTF1,DPSTF2,TETA,PDT,ICC1,ICC2,IMOD,IVIS,ITER,
*    &                ISIM,IBB,IGAU,IZON
C
C             *************************************************
C             **      CALCUL DU PARAMETRE D'ECROUISSAGE      **
C             *************************************************
C-------------------------------------------------------------------
C               IC=1 : COURBE de TRACTION
C               IC=2 : COURBE de COMPRESSION
C
       IRET=0
C
C ******************* direction de traction *******************
C
      IF (IC.EQ.1) THEN
      Ft=ALPHA*RB
C
C--------------- Courbe bilineaire --------------------------
C
      IF (ICC1.EQ.1) THEN
      DKUT=(2.D0*GFT)/(HC*Ft)
      DKLIM=Ft/YOUN
      IF (DKUT.LT.DKLIM) THEN
       IRET=1
       GOTO 10
      ENDIF
      DKUT1=0.95*DKUT
       IF (DK.GE.0.D0.AND.DK.LT.DKUT1) THEN
        PAEC=-(Ft/DKUT)
       ELSE
        PAEC=0.D0
       ENDIF
C
       IF (DK.GE.0.D0.AND.DK.LT.DKUT1) THEN
        SEQ=Ft*(1.D0-DK/DKUT)
       ELSE
        SEQ=0.05*Ft
       ENDIF
      ENDIF
C
C--------------- Courbe exponentielle -----------------------
C
      IF (ICC1.EQ.2) THEN
      DKUT=(3.D0*GFT)/(HC*Ft*(1.D0-EXP(-3.D0)))
      DKLIM=3.D0*Ft/YOUN
      IF (DKUT.LT.DKLIM) THEN
       IRET=1
       GOTO 10
      ENDIF
       PAEC=-3.D0*(Ft/DKUT)*EXP(-3.D0*DK/DKUT)
C
       SEQ=Ft*EXP(-3.D0*DK/DKUT)
      ENDIF
C
C------------------------------------------------------------
C
C *************** direction de compression ******************
C
      ELSE
C
      Rb=RB
C
C------------------- Courbe Feenstra -----------------------
C
      IF (ICC2.EQ.2) THEN
      DKE=(4.D0*Rb)/(3.D0*YOUN)
      DKU=1.5*(GFC/(HC*Rb))-(11.D0/48.D0)*DKE
      DKLIM=2.5*DKE
      IF (DKU.LT.DKLIM) THEN
       IRET=1
       GOTO 10
      ENDIF
       IF (DK.LT.DKE) THEN
        PAEC=(4.D0/3.D0)*(Rb/DKE)*(1.D0-(DK/DKE))
       ELSE IF (DK.GE.DKE.AND.DK.LT.DKU) THEN
        Denom=(DKU-DKE)*(DKU-DKE)
        PAEC=(-(2.D0*Rb)/Denom)*(DK-DKE)
       ELSE IF (DK.GE.DKU) THEN
        PAEC=0.D0
       ENDIF
C
       IF (DK.LT.DKE) THEN
        SEQ=(Rb/3.D0)*(1.D0+4.D0*(DK/DKE))
        SEQ=SEQ-(Rb/3.D0)*(2.D0*(DK*DK)/(DKE*DKE))
       ELSE IF (DK.GE.DKE.AND.DK.LT.DKU) THEN
        Dnum=(DK-DKE)*(DK-DKE)
        Denom=(DKU-DKE)*(DKU-DKE)
        SEQ=Rb*(1.D0-Dnum/Denom)
       ELSE IF (DK.GE.DKU) THEN
        SEQ=0.D0
       ENDIF
      ENDIF
C
C--------------- Courbe post pic lineaire -----------------
C
      IF (ICC2.EQ.1) THEN
      DKE=(4.D0*Rb)/(3.D0*YOUN)
      DKU=((2.D0*GFC)/(HC*Rb))+DKE
      DKLIM=1.75*DKE
      IF (DKU.LT.DKLIM) THEN
       IRET=1
       GOTO 10
      ENDIF
      DKU1=1*DKU
       IF (DK.LT.DKE) THEN
        PAEC=(4.D0/3.D0)*(Rb/DKE)*(1.D0-(DK/DKE))
       ELSE IF (DK.GE.DKE.AND.DK.LT.DKU1) THEN
        PAEC=-Rb/(DKU-DKE)
       ELSE IF (DK.GE.DKU1) THEN
        PAEC=0.D0
       ENDIF
C
       IF (DK.LT.DKE) THEN
        SEQ=(Rb/3.D0)*(1.D0+4.D0*(DK/DKE))
        SEQ=SEQ-(Rb/3.D0)*(2.D0*(DK*DK)/(DKE*DKE))
       ELSE IF (DK.GE.DKE.AND.DK.LT.DKU1) THEN
        Denom=(Rb)/(DKU-DKE)
        SEQ=Denom*(DKU-DK)
       ELSE IF (DK.GE.DKU1) THEN
        SEQ=0.*Rb
       ENDIF
      ENDIF
C--------------- Courbe bilineaire --------------------------
C
      IF (ICC2.EQ.0) THEN
      DKU=(2.D0*GFC)/(HC*Rb)
      DKLIM=Rb/YOUN
      IF (DKU.LT.DKLIM) THEN
       IRET=1
       GOTO 10
      ENDIF
      DKU1=0.8*DKU
       IF (DK.GE.0.D0.AND.DK.LT.DKU1) THEN
        PAEC=-(Rb/DKU)
       ELSE
        PAEC=0.D0
       ENDIF
C
       IF (DK.GE.0.D0.AND.DK.LT.DKU1) THEN
        SEQ=Rb*(1.D0-DK/DKU)
       ELSE
        SEQ=0.2*Rb
       ENDIF
      ENDIF
C
      ENDIF
C
   10 CONTINUE
      IF (IRET.EQ.1) THEN
      WRITE(*,*)'SNAP BACK, Vous n avez pas introduit une energie
     *telle que YOUN &lt; parametre d ecrouissage &lt; 0'
      IF(IC.EQ.1) THEN
       WRITE(*,*)'Le probleme est en traction dans l element',ibb
       WRITE(*,*)'DKUT=',DKUT
       WRITE(*,*)'DKLIM=',DKLIM
       WRITE(*,*)'HC=',HC
      ENDIF
      IF(IC.EQ.2) THEN
       WRITE(*,*)'Le probleme est en compression dans l element',ibb
       WRITE(*,*)'DKU=',DKU
       WRITE(*,*)'DKLIM=',DKLIM
       WRITE(*,*)'HC=',HC
      ENDIF
      STOP
      ENDIF
      RETURN
      END