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