Sources Esope | Cast3M

acianc
C ACIANC    SOURCE    CHAT      12/04/06    21:15:00     7348
C ACIANC    SOURCE    CHAT      05/01/12    21:15:36     5004
C
      SUBROUTINE ACIANC(XMAT,XCAR,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION XMAT(25),VAR0(18),VARF(18)
      DIMENSION EPSON(5),SIGMA(5),EPSON0(5),SIGMA0(5)
      CHARACTER*8 CMATE
C----------------------------------------------------------------------
C----------------------------------------------------------------------
C     Didier COMBESCURE - EMSI MAI 2000
C     MODELE D'ANCRAGE AVEC LA LOI ACIER_UNI POUR l'ACIER
C      ET ELIGEHAUSEN POUR LE GLISSEMENT
C
C     FONCTIONNE SUR LES ELEMENTS BARRES ET AVEC LE MODELE A FIBRE
C
C----------------------------------------------------------------------
C
C      XMAT( 1) YOUNG
C      XMAT( 2) NU
C      XMAT( 3) RHO
C      XMAT( 4) ALPHA
C      XMAT( 5) MAX. ELAST. STRESS
C      XMAT( 6) ULTIMATE STRESS
C      XMAT( 7) HARDENING STRAIN
C      XMAT( 8) ULTIMATE STRAIN
C      XMAT( 9) Ro FACTOR
C      XMAT(10) b  FACTOR
C      XMAT(11) a1 FACTOR
C      XMAT(12) a2 FACTOR
C      XMAT(13) FACTOR L/D
C      XMAT(14) a6 FACTOR
C      XMAT(15) c FACTOR
C      XMAT(16) a FACTOR
C      XMAT(17) KS
C      XMAT(18) S1T
C      XMAT(19) S2T
C      XMAT(20) S3T
C      XMAT(21) T1T
C      XMAT(22) T3T
C      XMAT(23) ALFA
C      XMAT(24) LANC
C      XMAT(25) SECT
C
C      DEPS(1) EPXX    SIG0(1) SIGF(1) SMXX
C      DEPS(2) GAXY    SIG0(2) SIGF(2) SMXY
C      DEPS(3) GAXZ    SIG0(3) SIGF(3) SMXZ
C
 
C                      VAR0( 1) VARF( 1) FLAG
C                      VAR0( 2) VARF( 2) EPSO
C                      VAR0( 3) VARF( 3) R FACTOR
C                      VAR0( 4) VARF( 4) TANGENT MODULUS
C                      VAR0( 5) VARF( 5) LAST REV. STRAIN
C                      VAR0( 6) VARF( 6) INTERSEPTION POINT
C                      VAR0( 7) VARF( 7) MAX. REV. POST. STRAIN
C                      VAR0( 8) VARF( 8) MIN. REV. POST. STRAIN
C                      VAR0( 9) VARF( 9) LAST REV. STRESS
C                      VAR0(10) VARF(10) INTERSEPTION POINT
C                      VAR0(11) VARF(11) MAX. REV. POST. STRESS
C                      VAR0(12) VARF(12) MIN. REV. POST. STRESS
C                      VAR0(13) VARF(13) EPPP
C                      VAR0(14) VARF(14) EPPM
C                      VAR0(15) VARF(15) EPSOA
C                      VAR0(16) VARF(16) KSTAN
C                      VAR0(17) VARF(17) NITER
C                      VAR0(18) VARF(18) XLAMBDA
C
C----------------------------------------------------------------------
C
C----------------------------------------------------------------------
*
-INC CCREEL
       XSECT = XCAR
C
C DONNEES GEOMETRIQUES DES ANCRAGES
C
       XDIAM = 2.D0*((XSECT/xpi)**0.5D0)
       XLANC = XMAT(24)
       XPERI = xpi*XDIAM
C
       IF (XLANC.LE.0.D0) THEN
         WRITE (*,*) 'Longueur d ancrage nulle ou négative'
         XLANC = 1.D-8
       ENDIF
C
C
C CARACTERISTIQUES ACIER
C
       EYOUN = XMAT( 1)
       FSY__ = XMAT( 5)
       FSU__ = XMAT( 6)
       EPSH_ = XMAT( 7)
       EPSU_ = XMAT( 8)
       ROFAC = XMAT( 9)
       BFACT = XMAT(10)
       A1FAC = XMAT(11)
       A2FAC = XMAT(12)
       FACLD = XMAT(13)
       A6FAC = XMAT(14)
       CFACT = XMAT(15)
       AFACT = XMAT(16)
C
C
C
C Joint
C
       G12 = XMAT(17)
       S1T = XMAT(18)
       S2T = XMAT(19)
       S3T = XMAT(20)
       T1T = XMAT(21)
       T3T = XMAT(22)
       ALFA = XMAT(23)
C
       G12S = 0.10D0*T1T/S1T
C
      XJACJOSE =   XPERI * (T1T/S1T) * XLANC
      XJACJOEL =   XPERI * G12 * XLANC
C
C
C Increment de deformation totale
C
       DEPS = DEPST
C
C
C Contrainte initiale dans l'acier
C
       XSIG0 = SIG0
C
C  VARIABLES INTERNES
C
C ACIERS
C
       IFLAG0 = NINT(VAR0(1))
       STRAI0 = VAR0(2)
       RFACT0 = VAR0(3)
       TANGE0 = VAR0(4)
C
       DO IFACT = 1, 2
          EPSON0(IFACT) = VAR0(4+IFACT)
          SIGMA0(IFACT) = VAR0(8+IFACT)
       END DO
C
       EPSON0(3) = VAR0(2)
       SIGMA0(3) = XSIG0
C
       DO IFACT = 4, 5
          EPSON0(IFACT) = VAR0(3+IFACT)
          SIGMA0(IFACT) = VAR0(7+IFACT)
       END DO
C
C VARIABLES INTERNES JOINT
C
C Glissements plastiques du joint
C
       EPPP   = VAR0(13)
       EPPM   = VAR0(14)
C
C Glissement total initial
C
       GLISJOI0 = VAR0(15)
C
C Déformation axiale correspondante
C
       EPSOJOI0 = GLISJOI0/XLANC
C
C
C Participation Glissement/déformation acier
C
C On estime la partition glissement/déformation initiale à partir
C des rigidités tangentes ou du lambda précédent
C
C
       CALL ELIGEH(GLISJOI0,G12,S1T,S2T,S3T,T1T,T3T,ALFA,
     .            EPPP,EPPM,EPPPF,EPPMF,XKTANJ,TAUF)
C
        XDENLAM = (XLANC*XKTANJ) + (0.25D0*XDIAM*TANGE0)
        IF (ABS(XDENLAM).GT.((1.D-6)*G12*XLANC)) THEN
           XLAMBDA = (XLANC*XKTANJ)/XDENLAM
        ELSE
           XLAMBDA = VAR0(18)
        ENDIF
C
C
       NITER = 0
C
C ON ITERE
C
 100   CONTINUE
C________________________________________________________________________
C
C     CALCUL DES CONTRAINTES ET DES DEFORMATIONS PLASTIQUES DANS L'ACIER
C_________________________________________________________________________
C
C
       DO IFACT = 1, 5
          EPSON(IFACT) = EPSON0(IFACT)
          SIGMA(IFACT) = SIGMA0(IFACT)
       END DO
C
       STRAI = STRAI0 + XLAMBDA*DEPS
       IFLAG = IFLAG0
       RFACT = RFACT0
       TANGE = TANGE0
C
       CALL STEEL1
     .       ( EYOUN, FSY__, FSU__, EPSH_, EPSU_, ROFAC, BFACT,
     .         A1FAC, A2FAC, FACLD, A6FAC, CFACT, AFACT, IFLAG,
     .         STRAI, RFACT, EPSON, SIGMA, TANGE, STRES )
C
C
C  XSIGF: CONTRAINTE ACIER
C
       XSIGF = STRES
       XTAN = TANGE
C
C  XFORACIE : Force correspondante
C
       XFORACIE = XSECT*XSIGF
       XJACACIE = XSECT*XTAN
       XJACACEL = XSECT*EYOUN
C_________________________________________
C
C FIN CALCUL CONTRAINTES DANS L'ACIER
C_________________________________________
C__________________________________________
C
C CALCUL CONTRAINTES DANS L'ANCRAGE
C__________________________________________
C
       GLISJOIN = GLISJOI0 + ((1.D0 - XLAMBDA)*DEPS*XLANC)
C
       CALL ELIGEH(GLISJOIN,G12,S1T,S2T,S3T,T1T,T3T,ALFA,
     .            EPPP,EPPM,EPPPF,EPPMF,XKTANJ,TAUF)
C
C
       XFORJOIN = XPERI * TAUF * XLANC
C
       XJACJOIN = XPERI * XKTANJ * XLANC
C
       XJACJOEL =   XPERI * G12 * XLANC
C____________________________________________
C
C FIN CALCUL CONTRAINTE DANS L'ANCRAGE
C____________________________________________
C
C
C CALCUL DU RESIDU
C
       XRESIDU = XFORACIE - XFORJOIN
C
C TEST DE SORTIE
C
       IF (ABS(XRESIDU/(XSECT*FSY__)).LE.1.D-7) GOTO 1000
C
C
        NITER = NITER + 1
C
      IF (NITER.GT.1000) THEN
          WRITE (*,*) 'Non convergence dans les itérations '
          WRITE (*,*) 'internes de ACIER_ANCRAGE'
         GOTO 1000
      ENDIF
C
C CALCUL DU JACOBIEN
C
C
       XJACTAN = (XJACACIE + (XLANC*XJACJOIN))
       IF (ABS(XJACTAN).LT. ((XJACACEL + (XLANC*XJACJOSE))*1.D-3)) THEN
           XJACTAN = ((XJACACEL + (XLANC*XJACJOSE))*1.D-3)
       ENDIF
C
       IF (NITER.EQ.1) THEN
         XJAC = XJACTAN*DEPS
       ELSEIF ((NITER.EQ.10)) THEN
         XJAC = XJACTAN*DEPS
       ELSEIF ((NITER.EQ.20)) THEN
         XJAC = XJACTAN*DEPS
       ELSEIF ((NITER.EQ.30)) THEN
         XJAC = XJACTAN*DEPS
       ELSEIF ((NITER.EQ.40)) THEN
         XJAC = XJACTAN*DEPS
       ELSEIF ((NITER.EQ.50)) THEN
         XJAC = (XJACACEL + (XLANC*XJACJOEL))*DEPS
         XLAMBDA = VAR0(18)
         GOTO 100
       ELSEIF ((NITER.EQ.100)) THEN
         XJAC = XJACTAN*DEPS
       ELSEIF (NITER.EQ.200) THEN
         XJAC = (XJACACEL + (XLANC*XJACJOEL))*DEPS
         XLAMBDA = 0.D0
         GOTO 100
       ELSEIF ((NITER.EQ.300)) THEN
         XJAC = XJACTAN*DEPS
       ENDIF
C
       IF (ABS(DEPS).LT.1.D-9) GOTO 1000
C
             XH0 = 1.0D0 / XJAC
             XLAMBDA = XLAMBDA - (XH0*XRESIDU)
C
          IF (ABS(XLAMBDA).GT.50.D0) THEN
            XLAMBDA = 0.D0
            XJAC = (XJACACEL + (XLANC*XJACJOEL))*DEPS
            GOTO 100
          ENDIF
C
       GOTO 100
C
C
 1000  CONTINUE
C
C     ON SORT
C
       SIGF = XSIGF
C
C
C  DEFORMATION PLASTIQUE ACIER
C
       DEFP    = (XLAMBDA*DEPS) - ((XSIGF - XSIG0) / EYOUN)
C
C VARIABLES INTERNES ACIER
C
       VARF(1) = DBLE(IFLAG)
       VARF(2) = STRAI
       VARF(3) = RFACT
       VARF(4) = TANGE
C
       DO IFACT = 1, 2
          VARF(4+IFACT) = EPSON(IFACT)
          VARF(8+IFACT) = SIGMA(IFACT)
       END DO
C
       DO IFACT = 4, 5
          VARF(3+IFACT) = EPSON(IFACT)
          VARF(7+IFACT) = SIGMA(IFACT)
       END DO
C
C VARIABLES INTERNES JOINT
C
       VARF(13) = EPPPF
       VARF(14) = EPPMF
       VARF(15) = GLISJOIN
       XKTADEN = (XJACJOIN*XLANC) + XJACACIE
       IF ((ABS(XKTADEN)).GE.1.D-10) THEN
         VARF(16) = XJACJOIN*XLANC*XJACACIE/(XKTADEN*XSECT)
       ELSE
         VARF(16) = 0.D0
       ENDIF
       VARF(17) = NITER
       VARF(18) = XLAMBDA
C
       RETURN
       END