Sources Esope | Cast3M

paranc
C PARANC    SOURCE    CHAT      12/04/06    21:15:23     7348
C
      SUBROUTINE PARANC(XMAT,XSECT,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCREEL
      DIMENSION XMAT(15),VAR0(8),VARF(8)
C----------------------------------------------------------------------
C
C     MODELE D'ANCRAGE POUR DES ELEMENTS DE BARRE ET
C     LE MODELE ACIER PLASTIQUE DU BAEL
C     LOI D'ADHERENCE ACIER-BETON D'ELIGEHAUSEN
C     D'APRES BARPAR et ELIGEH
C----------------------------------------------------------------------
C     Didier COMBESCURE - EMSI - MAI 2000
C----------------------------------------------------------------------
C
C      XMAT( 1) YOUNG
C      XMAT( 2) NU
C      XMAT( 3) RHO
C      XMAT( 4) ALPHA
C      XMAT( 5) FY
C      XMAT( 6) HH
C
C      XMAT( 7) KS
C      XMAT( 8) S1T
C      XMAT( 9) S2T
C      XMAT(10) S3T
C      XMAT(11) T1T
C      XMAT(12) T3T
C      XMAT(13) ALFA
C      XMAT(14) LANC
C
C
C      SIGF STRESS
C      DEPST,DEFP
C
C      VAR0( 1) VARF( 1) EPSE DEFORMATION PLASTIQUE
C      VAR0( 3) VARF( 3) EPPP
C      VAR0( 4) VARF( 4) EPPM
C      VAR0( 5) VARF( 5) EPSOA
C      VAR0( 6) VARF( 6) KSTAN
C      VAR0( 7) VARF( 7) NITER
C      VAR0( 8) VARF( 8) XLAMBDA
C
C----------------------------------------------------------------------
C DONNEES GEOMETRIQUES DES ANCRAGES
C
C
       XDIAM = 2.D0*((XSECT/xpi)**0.5D0)
       XLANC = XMAT(14)
       XPERI = xpi*XDIAM
C
C
       IF (XLANC.LE.0.D0) THEN
         WRITE (*,*) 'Longueur d ancrage nulle ou négative'
         XLANC = 1.D-8
       ENDIF
C
C
C Joint
C
       G12 = XMAT(7)
       S1T = XMAT(8)
       S2T = XMAT(9)
       S3T = XMAT(10)
       T1T = XMAT(11)
       T3T = XMAT(12)
       ALFA = XMAT(13)
C
       G12S = 0.10D0*T1T/S1T
C
      XJACJOSE =   XPERI * (T1T/S1T) * XLANC
      XJACJOEL =   XPERI * G12 * XLANC
C
C Acier
C
       GAMMA=XMAT(1)/2.D0/(XMAT(2)+1.D0)
       EYOUN = XMAT( 1)
       FYP = XMAT(5)
       FYN = (-1.D0)*XMAT(5)
       HHH = XMAT(6)
C
C Increment de deformation totale
C
       DEPS = DEPST
C
C
C Contrainte initiale dans l'acier
C
       XSIG0 = SIG0
C
C  Deformation plastique de l'acier
C
       XEPSE =  VAR0(1)
       EPSOACI0 = XEPSE + (XSIG0/EYOUN)
C
       FYPE = FYP + ( HHH * XEPSE)
       FYNE = FYN + ( HHH * XEPSE)
C
      TANGE0 = VAR0(2)
C
C Glissements plastiques du joint
C
       EPPP   = VAR0(3)
       EPPM   = VAR0(4)
C
C Glissement total initial
C
       GLISJOI0 = VAR0(5)
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(8)
        ENDIF
C
C
       NITER = 0
C
C ON ITERE
C
 100   CONTINUE
C        WRITE(*,*) NITER
C_________________________________________________________________________
C
C     CALCUL DES CONTRAINTES ET DES DEFORMATIONS PLASTIQUES DANS L'ACIER
C_________________________________________________________________________
C
C
       DEPSTA =  XLAMBDA*DEPS
C
       XSIGT = XSIG0 + (EYOUN * DEPSTA)
C
       IF (XSIGT . GT . FYPE) THEN
C
         XDEP = ((EYOUN/(EYOUN+HHH))*DEPSTA)
     &         + ((XSIG0 - FYPE)/(EYOUN+HHH))
         XSIGF =  XSIG0 + (EYOUN*(DEPSTA - XDEP))
         XTAN = (EYOUN*HHH)/(EYOUN+HHH)
C
       ELSEIF (XSIGT . LT . FYNE) THEN
C
         XDEP = ((EYOUN/(EYOUN+HHH))*DEPSTA)
     &         + ((XSIG0 - FYNE)/(EYOUN+HHH))
         XSIGF =  XSIG0 + (EYOUN*(DEPSTA - XDEP))
         XTAN = (EYOUN*HHH)/(EYOUN+HHH)
C
       ELSE
C
         XSIGF = XSIGT
         XDEP = 0.D0
         XTAN = EYOUN
C
       ENDIF
C
C  DEFORMATION PLASTIQUE ACIER
C
       XEPSET = XEPSE +XDEP
C
C
C  XSIGF: CONTRAINTE ACIER
C  XFORACIE : Force correspondante
C
       XFORACIE = XSECT*XSIGF
       XJACACIE = XSECT*XTAN
       XJACACEL = XSECT*EYOUN
C
C_________________________________________
C
C FIN CALCUL CONTRAINTES DANS L'ACIER
C_________________________________________
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*FYP)).LE.1.D-6) GOTO 1000
C
C
        NITER = NITER + 1
C
      IF (NITER.GT.1000) THEN
          WRITE (*,*) 'Non convergence dans les itérations '
          WRITE (*,*) 'internes de PARFAIT_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.5)) THEN
         XJAC = XJACTAN*DEPS
       ELSEIF ((NITER.EQ.10)) THEN
         XJAC = XJACTAN*DEPS
       ELSEIF ((NITER.EQ.15)) THEN
         XJAC = (XJACACEL + (XLANC*XJACJOEL))*DEPS
         XLAMBDA = VAR0(8)
         GOTO 100
       ELSEIF ((NITER.EQ.50)) THEN
         XJAC = XJACTAN*DEPS
       ELSEIF (NITER.EQ.100) THEN
         XJAC = (XJACACEL + (XLANC*XJACJOEL))*DEPS
         XLAMBDA = 0.D0
         GOTO 100
       ELSEIF ((NITER.EQ.150)) THEN
         XJAC = XJACTAN*DEPS
       ENDIF
C
       IF (ABS(DEPS).LT.1.D-5) GOTO 1000
C
             XH0 = 1.0D0 / XJAC
             XLAMBDA = XLAMBDA - (XH0*XRESIDU)
C
          IF (ABS(XLAMBDA).GT.50D0) THEN
            XLAMBDA = 0.D0
            XJAC = (XJACACEL + (XLANC*XJACJOEL))*DEPS
            GOTO 100
          ENDIF
C
       GOTO 100
C
C
 1000  CONTINUE
C
C     ON SORT
C
C
       SIGF = XFORACIE/XSECT
C
       VARF(1) = XEPSET
C
       VARF(2) = XJACACIE/XSECT
C
       VARF(3) = EPPPF
       VARF(4) = EPPMF
       VARF(5) = GLISJOIN
       XKTADEN = (XJACJOIN*XLANC) + XJACACIE
       IF ((ABS(XKTADEN)).GE.1.D-10) THEN
         VARF(6) = XJACJOIN*XLANC*XJACACIE/(XKTADEN*XSECT)
       ELSE
         VARF(6) = 0.D0
       ENDIF
       VARF(7) = NITER
       VARF(8) = XLAMBDA
C
       DEFP = XEPSET
C
       RETURN
       END