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 < parametre d ecrouissage < 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