Télécharger cotra1.eso

Retour à la liste

Numérotation des lignes :

  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.  
  147.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales