C PLASEC SOURCE CHAT 05/01/13 02:15:02 5004 C PLASEC SOURCE INSL 24/10/96 SUBROUTINE PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT, 1 TRAC,LTRA,MFR,NVARI,CMATE,XCAR,DDHOOK,NCARR,IFOUR) C---------------------------------------------------------------------- C PLASTICITE MODELE ISOTROPE C C ENTREES C SIG0(NSTRS) = CONTRAINTES INITIALES C NSTRS = NOMBRE DE CONTRAINTES C DSIGT(NSTRS) = INCREMENT DE CONTRAINTES TOTALES C VAR0(NVARI) = VARIABLES INTERNES DEBUT C VAR0( 1 ) = EPSP(1) C VAR0( 2 ) = EPSP(2) C VAR0( 3 ) = EPSP(3) C XMAT(NMATT) = COMPOSANTES DE MATERIAU C IVAL(NMATT) = INDICE DES COMPOSANTES DE MATERIAU C NMATT = NOMBRE DE COMPOSANTES DE MATERIAU C SORTIES C SIGF(NSTRS) = CONTRAINTES FINALES C VARF(NVARI) = VARIABLES INTERNES FINALES C----------------------------------------------------------------------- C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) * CHARACTER*8 CMATE DIMENSION SIG0(NSTRSS),VAR0(NVARI),SIGF(NSTRSS),VARF(NVARI) DIMENSION TRAC(LTRA),XMAT(NMATT),XCAR(NCARR),DEPST(NSTRSS) DIMENSION EPSLO(3),EPSL1(3),DEPSL(3),S1(3),SIGR(3),YOU(2) DIMENSION DDHOOK(NSTRSS,NSTRSS),DDHOMU(6,6),DSIGT(6),SIGL0(3) IRTD=1 C----------------------------------------------------------------------- IF(CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'UNIDIREC') GOTO 4 GOTO 46 C 4 CONTINUE C C PLASTICITE (DECOUPLE) ORTHOTROPE OU UNIDIRECTIONNELLE C CALL ZERO(EPSLO,3,1) CALL ZERO(DEPSL,3,1) CALL ZERO(EPSL1,3,1) CALL ZERO(S1,3,1) CALL ZERO(SIGR,3,1) CALL ZERO(SIGL0,3,1) CALL ZERO(YOU,2,1) * NSTRS=3 EPAIST=1.D0 IF(MFR.EQ.3.AND.NSTRSS.GT.3) THEN EPAIST=XCAR(1) ENDIF * DO I=1,NSTRS SIGR(I)=SIG0(I)/EPAIST END DO C C DEFINITION DES AXES ORTHO./AXES LOCAUX C IF(CMATE.EQ.'ORTHOTRO') THEN YOU(1) =XMAT(1) YOU(2) =XMAT(2) A =XMAT(5) B =XMAT(6) ELSE YOU(1) =XMAT(1) A =XMAT(2) B =XMAT(3) ENDIF C-------------------------------------------------------------------- C ROTATION DES CONTRAINTES ET DES DEFORMATIONS C DANS LE REPERE D'ORTHOTROPIE C PI=4.D0*DATAN(1.D0) PHI=(DATAN(B/A)*180.D0/PI)-90.D0 CALL DDRF(DEPST,PHI,DEPSL) CALL CDRF(SIGR,PHI,SIGL0) C IF(CMATE.EQ.'UNIDIREC'.OR.CMATE.EQ.'ORTHOTRO') THEN EPSL1(1)=VAR0(1)+SIGL0(1)/YOU(1)+DEPSL(1) CALL COUPLA(EPSL1(1),TRAC,LTRA,YOU(1),S1(1),PENTE) VARF(1)=EPSL1(1)-S1(1)/YOU(1) ENDIF * IF(CMATE.EQ.'ORTHOTRO'.AND.YOU(2).NE.0.D0) THEN EPSL1(2)=VAR0(2)+SIGL0(2)/YOU(2)+DEPSL(2) CALL COUPLA(EPSL1(2),TRAC,LTRA,YOU(2),S1(2),PENTE) VARF(2)=EPSL1(2)-S1(2)/YOU(2) ENDIF * CALL CDRG(S1,PHI,SIGR) DO I=1,NSTRS SIGF(I)=SIGR(I)*EPAIST END DO IF(NSTRSS.EQ.4) THEN SIGF(3)=0.D0 SIGF(4)=SIGR(3)*EPAIST ENDIF * IF(NSTRSS.EQ.6) THEN CALL ZERO(DDHOMU,6,6) CALL ZERO(DDHOOK,NSTRSS,NSTRSS) CALL ZERO(DSIGT,6,1) * CALL DOHCOM(XMAT,NMATT,CMATE,IFOUR,NSTRSS,DDHOOK,IRTD) CALL HOOKMU(EPAIST,0.D0,NSTRSS,DDHOOK,DDHOMU) CALL BST(DDHOMU,DEPST,NSTRSS,NSTRSS,DSIGT) * DO I = 4,NSTRSS SIGF(I)=SIG0(I)+DSIGT(I) END DO ENDIF GOTO 510 C----------------------------------------------------------------------- C C PLASTICITE ISOTROPE UNIAXIALE C 46 CONTINUE SECT=XCAR(1) YOU1=XMAT(1) C EPSX=VAR0(1)+SIG0(1)/YOU1/SECT+DEPST(1) CALL COUPLA(EPSX,TRAC,LTRA,YOU1,SIGRX,PENTE) VARF(1)=EPSX-SIGRX/YOU1 SIGF(1)=SIGRX*SECT C 510 CONTINUE C----------------------------------------------------------------------- 1991 FORMAT(18(1X,E10.3)) 2007 FORMAT(7(6(1X,E12.5),/)) 2008 FORMAT(7(6(1X,I12),/)) 1000 FORMAT(5X,' *** ATTENTION ELEMENT NON COMPATIBLE AVEC CE MODELE' *,/,10X,'ROUTINE = PLASEC : ELEMENT = ',I3) RETURN END