C PENT1     SOURCE    FANDEUR   09/09/23    21:15:46     6374

      SUBROUTINE PENT1(EPS,SIDD,YOU,SIGY,XXHH,TRAC,LTRAC,MAPL,XPREC,
     &                 YOUTA,ILOGPL)

C======================================================================
C sous-programme PENTE auquel on a enleve le calcul de la contrainte
C equivalente
C
C   CALCULE LE MODULE TANGENT A PARTIR DE LA COURBE DE TRACTION
C   CONTRAINTES VERSUS DEFORMATIONS PLASTIQUES
C
C   ENTREES
C     EPS         =  DEFORMATION PLASTIQUE EQUIVALENTE
C     SIDD        =  CRITERE : CONTRAINTE EQUIVALENTE DE VON MISES
C                    SAUF POUR DRUCKER PRAGER : A TR(S) + B Seq
C     YOU         =  MODULE D YOUNG
C     SIGY        =  LIMITE ELASTIQUE
C     XXHH        =  DEUXIEME PENTE (SAUF POUR DRUCKER)
C     TRAC(LTRAC) =  COURBE DE TRACTION
C                      TRAC(1,3,5,7,9) LES CONTRAINTES
C                      TRAC(2,4,6,8,10) LES EPSILONS EQUIVALENTS
C     MAPL        =  NUMERO MODELE PLASTICITE
C     XPREC       =  PRECISION POUR TROUVER LA POSITION SUR
C                    LA COURBE DE TRACTION
C   SORTIES
C     YOUTA       =  MODULE TANGENT
C     ILOGPL      =  0   EN DESSOUS   PAS PLASTIFIE
C                    1   DESSUS       PLASTIFIE
C                   -1   EN DEHORS    EXECUTION IMPOSSIBLE
C====================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

      PARAMETER (XZER=0.D0,XUN=1.D0)

      DIMENSION TRAC(*)
C
C   ON CHERCHE LA PENTE CORRESPONDANT A EPS
C
C   PLASTICITE PARFAITE  ET DRUCKER PRAGER
C
      IF (MAPL.EQ.1.OR.MAPL.EQ.3.OR.MAPL.EQ.15) THEN
        IF (EPS.LE.XZER) THEN
          IF (SIDD.LE.SIGY) THEN
            ILOGPL=0
            YOUTA=YOU
C*        ELSE IF (SIDD.GT.SIGY) THEN
          ELSE
            ILOGPL=-1
          ENDIF
        ELSE
          SIGYP=SIGY*(XUN+XPREC)
          SIGYM=SIGY*(XUN-XPREC)
          IF (SIDD.LT.SIGYM) THEN
            ILOGPL=0
            YOUTA=YOU
C*        ELSE IF (SIDD.GE.SIGYM.AND.SIDD.LE.SIGYP) THEN
          ELSE IF (SIDD.LE.SIGYP) THEN
            ILOGPL=1
            YOUTA=XZER
C*        ELSE IF (SIDD.GT.SIGYP) THEN
          ELSE
            ILOGPL=-1
          ENDIF
        ENDIF
C
C   ECROUISSAGE CINEMATIQUE BILINEAIRE
C
      ELSE IF (MAPL.EQ.4) THEN
        IF (EPS.LE.XZER) THEN
          IF (SIDD.LE.SIGY) THEN
            ILOGPL=0
            YOUTA=YOU
C*        ELSE IF (SIDD.GT.SIGY) THEN
          ELSE
            ILOGPL=-1
          ENDIF
        ELSE
          SICC = SIGY + XXHH * EPS
          SICCP=SICC*(XUN+XPREC)
          SICCM=SICC*(XUN-XPREC)
          IF (SIDD.LT.SICCM) THEN
            ILOGPL=0
            YOUTA=YOU
C*        ELSE IF (SIDD.GE.SICCM.AND.SIDD.LE.SICCP) THEN
          ELSE IF (SIDD.LE.SICCP) THEN
            ILOGPL=1
            YOUTA=XXHH
C*        ELSE IF (SIDD.GT.SICCP) THEN
          ELSE
            ILOGPL=-1
          ENDIF
        ENDIF
C
C  PLASTICITE ISOTROPE OU CINEMATIQUE
C
      ELSE IF (MAPL.EQ.5.OR.MAPL.EQ.6) THEN
        SIGYE = TRAC(1)
        IF (EPS.LE.XZER) THEN
          IF (SIDD.LE.SIGYE) THEN
            ILOGPL=0
            YOUTA=YOU
C*        ELSE IF (SIDD.GT.SIGYE) THEN
          ELSE
            ILOGPL=-1
          ENDIF
        ELSE
          DO IA=4,LTRAC,2
            IF (TRAC(IA).GE.EPS) GOTO 110
          ENDDO
          IA = LTRAC
 110      CONTINUE
          XX = TRAC(IA)   - TRAC(IA-2)
          YY = TRAC(IA-1) - TRAC(IA-3)
          HPRIM = YY / XX
          SICC = TRAC(IA-1) + ( EPS - TRAC(IA) ) * HPRIM
          SICCP=SICC*(XUN+XPREC)
          SICCM=SICC*(XUN-XPREC)
          IF (SIDD.LT.SICCM) THEN
            ILOGPL= 0
            YOUTA = YOU
C*        ELSE IF (SIDD.LE.SICCP.AND.SIDD.GE.SICCM) THEN
          ELSE IF (SIDD.LE.SICCP) THEN
            ILOGPL= 1
            YOUTA = HPRIM * YOU / ( HPRIM + YOU )
C*        ELSE IF (SIDD.GT.SICCP)  THEN
          ELSE
            ILOGPL=-1
          ENDIF
        ENDIF
C
C     Autre comportement plastique : KTANGA prendra la matrice elastique
C
      ELSE
        ILOGPL = 0
      ENDIF

      RETURN
      END