Esope source files

   1 : C COTRA1    SOURCE    FANDEUR   09/09/23    21:15:00     6374           
   2 : 
   3 :       SUBROUTINE COTRA1 (ITRAC,YYYY,LTRAC,TRAC,NTRAC,KERRE)
   4 : 
   5 : C=======================================================================
   6 : C=   Remplissage de la courbe Contrainte-Deformation plastique utile   =
   7 : C=   pour le calcul de la matrice tangente a partir de la courbe de    =
   8 : C=   traction Contrainte-Deformation (totale)                          =
   9 : C=                                                                     =
  10 : C= Entrees :                                                           =
  11 : C= ---------                                                           =
  12 : C=   ITRAC    Pointeur sur un objet EVOLUTION de la courbe de traction =
  13 : C=            Segment desactive en E/S                                 =
  14 : C=    YYYY    Module de YOUNG (pente initiale de la courbe)            =
  15 : C=    LTRAC   Nombre maximal de valeurs de la courbe Sigma-Def.Plas    =
  16 : C=            Dimension du vecteur TRAC lors de sa declaration FORTRAN =
  17 : C= Sorties :                                                           =
  18 : C= ---------                                                           =
  19 : C=    TRAC(*) Points de la courbe Contrainte-Deformation plastique     =
  20 : C=            TRAC(1,3,5,7,...) Contraintes                            =
  21 : C=            TRAC(2,4,6,8,...) Deformations plastiques                =
  22 : C=    NTRAC   Nombre de valeurs de la courbe TRAC (Sigma-Def.Plas)     =
  23 : C=    KERRE   Indicateur de SUCCES (= 0) et d'ERREUR sinon             =
  24 : C=                                                                     =
  25 : C=  Les valeurs de KERRE de l'ERREUR associee sont :      ERREUR(   )  =
  26 : C=    Contrainte ultime nulle                               270        =
  27 : C=    Trop de points sur la courbe de traction              271        =
  28 : C=    Pas assez de points sur la courbe de traction         272        =
  29 : C=    Pente en un point superieure au module de Young       273        =
  30 : C=    Module de Young du materiau nul                       325        =
  31 : C=    Pente a l'origine non egale au module de Young        330        =
  32 : C=    Courbe de traction vide                               354        =
  33 : C=======================================================================
  34 : 
  35 :       IMPLICIT INTEGER(I-N)
  36 :       IMPLICIT REAL*8(A-H,O-Z)
  37 : 
  38 : -INC SMEVOLL
  39 : -INC SMLREEL
  40 : 
  41 :       PARAMETER(XPREC=1.D-3,XZER=0.D0,UN=1.D0)
  42 :       DIMENSION TRAC(*)
  43 : 
  44 :       KERRE=0
  45 : C  Quelques verifications d'usage :
  46 : C===================================
  47 : C= Module de Young nul ?
  48 :       IF (YYYY.LE.XZER) THEN
  49 :         KERRE=325
  50 :         RETURN
  51 :       ENDIF
  52 : C= Pointeur sur la courbe de traction errone ?
  53 :       IF (ITRAC.LE.0) THEN
  54 :         KERRE=354
  55 :         RETURN
  56 :       ENDIF
  57 : C= On recupere l'objet EVOLUTION
  58 :       MEVOLL=ITRAC
  59 :       SEGACT,MEVOLL
  60 :       KEVOLL=IEVOLL(1)
  61 : C*//  SEGDES,MEVOLL
  62 : C
  63 :       SEGACT,KEVOLL
  64 :       MLREEL=IPROGX
  65 :       MLREE1=IPROGY
  66 : C*//  SEGDES,KEVOLL
  67 : C
  68 :       SEGACT,MLREEL,MLREE1
  69 :       NBPOIX=PROG(/1)
  70 : C
  71 : C  TROP DE POINTS SUR LA COURBE DE TRACTION OU PAS ASSEZ
  72 : C
  73 :       IF (NBPOIX.LT.3) THEN
  74 :         KERRE=272
  75 :         GOTO 777
  76 :       ENDIF
  77 :       NTRAC=2*NBPOIX
  78 :       IF (NTRAC.GT.LTRAC) THEN
  79 :         KERRE=271
  80 :         GOTO 777
  81 :       ENDIF
  82 : C
  83 : C  VERIF CONTRAINTE ULTIME NON NULLLE
  84 : C
  85 :       XLIM=MLREE1.PROG(2)
  86 :       IF (XLIM.LE.XZER) THEN
  87 :         KERRE=270
  88 :         GOTO 777
  89 :       ENDIF
  90 : C
  91 : C  VERIF DE LA PENTE A L ORIGINE EGALE AU MODULE D YOUNG
  92 : C
  93 :       YUNG = YYYY
  94 :       YUNP = YUNG*(UN+XPREC)
  95 :       YUNM = YUNG*(UN-XPREC)
  96 :       ESTYO = XLIM / PROG(2)
  97 :       IF (ESTYO.GT.YUNP .OR. ESTYO.LT.YUNM) THEN
  98 :         KERRE=330
  99 :         GOTO 777
 100 :       ENDIF
 101 : C
 102 : C  VERIF DE LA PENTE
 103 : C
 104 :       DO 100 I=3,NBPOIX
 105 :         I1=I-1
 106 :         DEPS=PROG(I)-PROG(I1)
 107 :         IF (DEPS.LE.XZER) THEN
 108 :           KERRE=273
 109 :           GOTO 777
 110 :         ENDIF
 111 :         PENTE=(MLREE1.PROG(I)-MLREE1.PROG(I1))/DEPS
 112 :         IF (PENTE.GE.YUNP) THEN
 113 :           KERRE=273
 114 :           GOTO 777
 115 :         ENDIF
 116 :  100  CONTINUE
 117 : 
 118 : C Remplissage de la courbe de traction Contrainte-Deformation plastique
 119 : C
 120 :       NCOUR=0
 121 :       DO 200 I=2,NBPOIX
 122 :         NCOUR=NCOUR+2
 123 :         PSIG=MLREE1.PROG(I)
 124 :         TRAC(NCOUR-1)=PSIG
 125 :         TRAC(NCOUR  )=PROG(I) - (PSIG / YUNG)
 126 :   200 CONTINUE
 127 : C
 128 : C       ON REMPLIT JUSQUE AU BOUT
 129 : C
 130 :       IF (NCOUR.LT.LTRAC) THEN
 131 :         NCOUR2=NCOUR+2
 132 :         DEPS = TRAC(NCOUR  )-TRAC(NCOUR-2)
 133 :         DSIG = TRAC(NCOUR-1)-TRAC(NCOUR-3)
 134 :         DO 250 I=NCOUR2,LTRAC,2
 135 :           TRAC(I  ) = TRAC(I-2) + DEPS
 136 :           TRAC(I-1) = TRAC(I-3) + DSIG
 137 :  250    CONTINUE
 138 :       ENDIF
 139 : 
 140 :  777  CONTINUE
 141 : C*//  SEGDES,MLREEL,MLREE1
 142 : 
 143 :       RETURN
 144 :       END
 145 : 
 146 :