Télécharger cotror.eso

Retour à la liste

Numérotation des lignes :

  1. C COTROR SOURCE CHAT 05/01/12 22:23:54 5004
  2. C COTROR SOURCE BROC 89/07/19 21:22:26
  3. SUBROUTINE COTROR(WRK0,WRK2,NCOURB,MVEL1,KERRE)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. -INC SMEVOLL
  7. -INC SMLREEL
  8. SEGMENT/WRK0/(XMAT(NCOMAT)*D)
  9. SEGMENT/WRK2/(TRAC(LTRAC)*D)
  10. DATA NCOMAX/130/
  11. KERRE=0
  12. MEVOLL=MVEL1
  13. IF(MEVOLL.EQ.0) THEN
  14. KERRE=37
  15. RETURN
  16. ENDIF
  17. SEGACT MEVOLL
  18. KEVOLL=IEVOLL(1)
  19. SEGACT KEVOLL
  20. MLREEL=IPROGX
  21. MLREE1=IPROGY
  22. SEGDES KEVOLL
  23. SEGACT MLREEL,MLREE1
  24. NBPOIX=PROG(/1)
  25. NBPOIY=MLREE1.PROG(/1)
  26. IF(NBPOIX.GT.NCOMAX+1) KERRE=31
  27. IF(NBPOIX.LT.3) KERRE=32
  28. IF(KERRE.EQ.0) GO TO 693
  29. 692 CONTINUE
  30. C
  31. C ERREUR
  32. C
  33. SEGDES MLREEL,MLREE1
  34. SEGDES MEVOLL
  35. GO TO 777
  36. 693 CONTINUE
  37. C
  38. C TESTS SUR LES POINTS DE LA COURBE ( A COMPLETER )
  39. C
  40. YUNG=XMAT(1)
  41. IF(YUNG.EQ.0.D0) THEN
  42. KERRE=34
  43. GO TO 692
  44. ENDIF
  45. PSIG=MLREE1.PROG(1)
  46. PEPS=PROG(1)
  47. IF(PSIG.NE.0.D0.OR.PEPS.NE.0.D0) THEN
  48. KERRE=35
  49. GO TO 692
  50. ENDIF
  51. C
  52. C VERIF DE LA LIMITE ELASTIQUE NON NULLE
  53. C
  54. PSIG =MLREE1.PROG(1)
  55. PEPS=PROG(1)
  56. PENTE=PSIG/PEPS
  57. RA=ABS(PENTE-YUNG)/YUNG
  58. IF(RA.GT.5.D-3) THEN
  59. KERRE=36
  60. GO TO 692
  61. ENDIF
  62. C
  63. C VERIF DE LA PENTE
  64. C
  65. DO 100 I=3,NBPOIX
  66. I1=I-1
  67. DEPS=PROG(I)-PROG(I1)
  68. IF(DEPS.EQ.0.D0) THEN
  69. KERRE=33
  70. GO TO 692
  71. ENDIF
  72. PENTE=(MLREE1.PROG(I)-MLREE1.PROG(I1))/DEPS
  73. IF(PENTE.GE.YUNG) THEN
  74. KERRE=33
  75. GO TO 692
  76. ENDIF
  77. 100 CONTINUE
  78. TRAC(1)=MLREE1.PROG(1)
  79. TRAC(2)=0.D0
  80. NCOURB=1
  81. DO 695 I=2,NBPOIX
  82. PSIG=MLREE1.PROG(I)
  83. PEPS=PROG(I)
  84. NCOURB=NCOURB+1
  85. TRAC(2*NCOURB-1)=PSIG
  86. TRAC(2*NCOURB)=PEPS
  87. 695 CONTINUE
  88. C
  89. SEGDES MLREEL,MLREE1
  90. SEGDES MEVOLL
  91. RETURN
  92. C
  93. 777 CONTINUE
  94. RETURN
  95. END
  96.  
  97.  
  98.  

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