C PLASEC    SOURCE    CB215821  16/04/21    21:18:02     8920
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*ATAN(1.D0)
      PHI=(ATAN(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