Télécharger la plaquette Cast3M


fr en

Télécharger ccotr4.eso

Retour à la liste

Numérotation des lignes : 

ccotr4

  1. C CCOTR4    SOURCE    OF166741  25/09/30    21:15:03     12371          
  2.  
  3.       SUBROUTINE CCOTR4(WRK52,WRK2,NCOURB,WRK53)
  4.  
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10.  
  11. -INC SMEVOLL
  12. -INC SMLREEL
  13. -INC DECHE
  14. -INC CCREEL
  15.  
  16.       SEGMENT/WRK2/(TRAC(LTRAC)*D)
  17.  
  18.       DATA NCOMAX/130/
  19.  
  20.       KERRE=0
  21. C
  22. C   TEST SUR LE MODULE DE YOUNG
  23. C
  24.       YUNG = XMAT(1)
  25.       IF (YUNG .LE. 0.D0) THEN
  26.         REAERR(1)=YUNG
  27.         CALL ERREUR(1090)
  28.         KERRE=34
  29.         RETURN
  30.       ENDIF
  31. C
  32. C  TESTS SUR LES POINTS DE LA COURBE   ( A COMPLETER )
  33. C
  34.       MEVOLL = NINT(XMAT(5))
  35.       SEGACT,MEVOLL
  36.       KEVOLL = mevoll.IEVOLL(1)
  37.       SEGACT,KEVOLL
  38.       MLREEL = kevoll.IPROGX
  39.       MLREE1 = kevoll.IPROGY
  40. c//      SEGDES,KEVOLL
  41. c//      SEGDES,MEVOLL
  42.  
  43.       SEGACT,MLREEL,MLREE1
  44.       NBPOIX = mlreel.PROG(/1)
  45.       NBPOIY = mlree1.PROG(/1)
  46.       IF (NBPOIX.NE.NBPOIY) THEN
  47.         KERRE=31
  48.       ELSE IF (NBPOIX.GT.NCOMAX+1) THEN
  49.         KERRE=31
  50.       ELSE IF (NBPOIX.LT.3) THEN
  51.         KERRE=32
  52.       ENDIF
  53.       IF (KERRE.NE.0) RETURN
  54. C
  55. C  Premier point doit etre a deformation et contrainte nulles
  56. C
  57.       PEPS = mlreel.PROG(1)
  58.       PSIG = mlree1.PROG(1)
  59.       IF (PSIG.NE.0.D0 .OR. PEPS.NE.0.D0) THEN
  60.         REAERR(1)=PEPS
  61.         REAERR(2)=PSIG
  62.         CALL ERREUR(1092)
  63.         KERRE=35
  64.         RETURN
  65.       ENDIF
  66. C
  67. C  Second point doit etre a deformation plastique nulle
  68. C  et a contrainte = LIMITE ELASTIQUE NON NULLE
  69. C  La pente doit etre egale au module de Young
  70. C
  71.       PEPS = mlreel.PROG(2)
  72.       PSIG = MLREE1.PROG(2)
  73.       IF (PEPS.LE.0.D0) THEN
  74.         REAERR(1)=PEPS
  75.         CALL ERREUR(1089)
  76.         KERRE=35
  77.         RETURN
  78.       ENDIF
  79.       IF (PSIG.LE.0.D0) THEN
  80.         REAERR(1)=PSIG
  81.         CALL ERREUR(1091)
  82.         KERRE=30
  83.         RETURN
  84.       ENDIF
  85.       PENTE=PSIG/PEPS
  86.       RA=ABS(PENTE-YUNG)/YUNG
  87.       IF (RA.GT.1.D-3) THEN
  88.         REAERR(1)=PENTE
  89.         REAERR(2)=YUNG
  90.         CALL ERREUR(1088)
  91.         KERRE=36
  92.         RETURN
  93.       ENDIF
  94. C
  95. C  Construction de la courbe Sigma fonction de Eps_plastique 
  96. C*C  (TEST INHIBE) VERIFICATION QUE LA PENTE est inferieure au module de Young
  97. C
  98.       NCOURB = 1
  99.       TRAC(1) = PSIG
  100.       TRAC(2) = 0.D0
  101.       DO I=3,NBPOIX
  102.         PEPS=mlreel.PROG(I)
  103.         PSIG=mlree1.PROG(I)
  104.         I1=I-1
  105.         DEPS=PEPS-mlreel.PROG(I1)
  106.         IF(DEPS.LE.0.D0) THEN
  107.           CALL ERREUR(1087)
  108.           KERRE=33
  109.           RETURN
  110.         ENDIF
  111. C*        PENTE=(PSIG-MLREE1.PROG(I1))/DEPS
  112. C*        IF (PENTE.GT.1.01*YUNG) THEN
  113. C*          REAERR(1)=PENTE
  114. C*          REAERR(2)=YUNG
  115. C*          CALL ERREUR(1088)
  116. C*          KERRE=33
  117. C*          RETURN
  118. C*        ENDIF
  119.         NCOURB=NCOURB+1
  120.         TRAC(2*NCOURB-1)= PSIG
  121.         TRAC(2*NCOURB)  = PEPS-PSIG/YUNG
  122.       ENDDO
  123.  
  124. c      RETURN
  125.       END
  126.  
  127.  
  128.  

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