C COTRA1    SOURCE    FANDEUR   09/09/23    21:15:00     6374           

      SUBROUTINE COTRA1 (ITRAC,YYYY,LTRAC,TRAC,NTRAC,KERRE)

C=======================================================================
C=   Remplissage de la courbe Contrainte-Deformation plastique utile   =
C=   pour le calcul de la matrice tangente a partir de la courbe de    =
C=   traction Contrainte-Deformation (totale)                          =
C=                                                                     =
C= Entrees :                                                           =
C= ---------                                                           =
C=   ITRAC    Pointeur sur un objet EVOLUTION de la courbe de traction =
C=            Segment desactive en E/S                                 =
C=    YYYY    Module de YOUNG (pente initiale de la courbe)            =
C=    LTRAC   Nombre maximal de valeurs de la courbe Sigma-Def.Plas    =
C=            Dimension du vecteur TRAC lors de sa declaration FORTRAN =
C= Sorties :                                                           =
C= ---------                                                           =
C=    TRAC(*) Points de la courbe Contrainte-Deformation plastique     =
C=            TRAC(1,3,5,7,...) Contraintes                            =
C=            TRAC(2,4,6,8,...) Deformations plastiques                =
C=    NTRAC   Nombre de valeurs de la courbe TRAC (Sigma-Def.Plas)     =
C=    KERRE   Indicateur de SUCCES (= 0) et d'ERREUR sinon             =
C=                                                                     =
C=  Les valeurs de KERRE de l'ERREUR associee sont :      ERREUR(   )  =
C=    Contrainte ultime nulle                               270        =
C=    Trop de points sur la courbe de traction              271        =
C=    Pas assez de points sur la courbe de traction         272        =
C=    Pente en un point superieure au module de Young       273        =
C=    Module de Young du materiau nul                       325        =
C=    Pente a l'origine non egale au module de Young        330        =
C=    Courbe de traction vide                               354        =
C=======================================================================

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC SMEVOLL
-INC SMLREEL

      PARAMETER(XPREC=1.D-3,XZER=0.D0,UN=1.D0)
      DIMENSION TRAC(*)

      KERRE=0
C  Quelques verifications d'usage :
C===================================
C= Module de Young nul ?
      IF (YYYY.LE.XZER) THEN
        KERRE=325
        RETURN
      ENDIF
C= Pointeur sur la courbe de traction errone ?
      IF (ITRAC.LE.0) THEN
        KERRE=354
        RETURN
      ENDIF
C= On recupere l'objet EVOLUTION
      MEVOLL=ITRAC
      SEGACT,MEVOLL
      KEVOLL=IEVOLL(1)
C*//  SEGDES,MEVOLL
C
      SEGACT,KEVOLL
      MLREEL=IPROGX
      MLREE1=IPROGY
C*//  SEGDES,KEVOLL
C
      SEGACT,MLREEL,MLREE1
      NBPOIX=PROG(/1)
C
C  TROP DE POINTS SUR LA COURBE DE TRACTION OU PAS ASSEZ
C
      IF (NBPOIX.LT.3) THEN
        KERRE=272
        GOTO 777
      ENDIF
      NTRAC=2*NBPOIX
      IF (NTRAC.GT.LTRAC) THEN
        KERRE=271
        GOTO 777
      ENDIF
C
C  VERIF CONTRAINTE ULTIME NON NULLLE
C
      XLIM=MLREE1.PROG(2)
      IF (XLIM.LE.XZER) THEN
        KERRE=270
        GOTO 777
      ENDIF
C
C  VERIF DE LA PENTE A L ORIGINE EGALE AU MODULE D YOUNG
C
      YUNG = YYYY
      YUNP = YUNG*(UN+XPREC)
      YUNM = YUNG*(UN-XPREC)
      ESTYO = XLIM / PROG(2)
      IF (ESTYO.GT.YUNP .OR. ESTYO.LT.YUNM) THEN
        KERRE=330
        GOTO 777
      ENDIF
C
C  VERIF DE LA PENTE
C
      DO 100 I=3,NBPOIX
        I1=I-1
        DEPS=PROG(I)-PROG(I1)
        IF (DEPS.LE.XZER) THEN
          KERRE=273
          GOTO 777
        ENDIF
        PENTE=(MLREE1.PROG(I)-MLREE1.PROG(I1))/DEPS
        IF (PENTE.GE.YUNP) THEN
          KERRE=273
          GOTO 777
        ENDIF
 100  CONTINUE

C Remplissage de la courbe de traction Contrainte-Deformation plastique
C
      NCOUR=0
      DO 200 I=2,NBPOIX
        NCOUR=NCOUR+2
        PSIG=MLREE1.PROG(I)
        TRAC(NCOUR-1)=PSIG
        TRAC(NCOUR  )=PROG(I) - (PSIG / YUNG)
  200 CONTINUE
C
C       ON REMPLIT JUSQUE AU BOUT
C
      IF (NCOUR.LT.LTRAC) THEN
        NCOUR2=NCOUR+2
        DEPS = TRAC(NCOUR  )-TRAC(NCOUR-2)
        DSIG = TRAC(NCOUR-1)-TRAC(NCOUR-3)
        DO 250 I=NCOUR2,LTRAC,2
          TRAC(I  ) = TRAC(I-2) + DEPS
          TRAC(I-1) = TRAC(I-3) + DSIG
 250    CONTINUE
      ENDIF

 777  CONTINUE
C*//  SEGDES,MLREEL,MLREE1

      RETURN
      END