Télécharger la plaquette Cast3M


fr en

Télécharger cotati.eso

Retour à la liste

Numérotation des lignes : 

cotati

  1. C COTATI    SOURCE    PV        17/12/08    21:16:59     9660           
  2. C ROTATI    SOURCE    AM        00/12/13    21:42:28     4045
  3. C MAZZZ     SOURCE    AM        92/09/30    21:43:12     712
  4.       SUBROUTINE COTATI(WRK52,WRK53,WRK54,NSTRS1,NVARI,ICARA)
  5. C
  6. C    calcule la deformation initiale et l'increment de deformation
  7. C    a partir de la contrainte initiale et l'increment de contrainte
  8. C    elastique puis appelle la subroutine ROTAT2
  9. C
  10. C
  11. C     variables en entree
  12. C
  13. C     WRK0,KRK1,WRK5  pointeurs sur des segments de travail
  14. C
  15. C     NSTRS1      nombre de composantes dans les vecteurs des contraintes
  16. C                                        et les vecteurs des deformations
  17. C
  18. C     NVARI      nombre de variables internes (doit etre egal a 2)
  19. C
  20. C     NMATT      nombre de constantes du materiau
  21. C
  22. C     ISTEP      flag utilise pour separer les etapes dans un calcul non local
  23. C                ISTEP=0 -----> calcul local
  24. C                ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
  25. C                ISTEP=2 -----> calcul non local etape 2 on continue le calcul
  26. C                               a partir des seuils moyennes
  27. C
  28. C
  29. C     variables en sortie
  30. C
  31. C     VARF      variables internes finales dans WRK0
  32. C
  33. C     SIGF      contraintes finales dans WRK0
  34.       IMPLICIT INTEGER(I-N)
  35.       IMPLICIT REAL*8(A-H,O-Z)
  36.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC DECHE
  40. *
  41.       SEGMENT WRKK2
  42.          REAL*8 EPSILI(NSTRS)
  43.       END SEGMENT
  44.       INTEGER NSTRS1,NVARI
  45.       INTEGER KCAS,IRTD,ISTRS
  46.       REAL*8 PREC
  47.       REAL*8 UN
  48.       PARAMETER (UN=1.D0)
  49.       KERRE=0
  50. C
  51. C     calcul de la matrice elastique
  52. C
  53.       CMATE = 'ISOTROPE'
  54.       KCAS=1
  55.       CALL DOHMAS(XMAT,CMATE,IFOUR,NSTRS1,KCAS,DDHOOK,IRTD)
  56.       IF ( IRTD .EQ. 1) THEN
  57. C
  58. C     inversion de cette matrice
  59. C
  60.          PREC=1.D-08
  61.          SEGINI WRKK2
  62.          IF (IFOUR.EQ.-2) THEN
  63.            CALL INVALM(DDHOOK,NSTRS1,2,IRTD,PREC)
  64.            DDHOOK(4,4)=1/DDHOOK(4,4)
  65.          ELSE
  66.            CALL INVALM(DDHOOK,NSTRS1,NSTRS1,IRTD,PREC)
  67.          ENDIF
  68.          IF (IRTD.EQ.0)THEN
  69. C
  70. C     calcul des deformations du materiau elastique lineaire
  71. C
  72.             CALL MATVE1 (DDHOOK,SIG0,NSTRS1,NSTRS1,EPSILI,1)
  73. C
  74. C     modification pour tenir compte de l'endommagement
  75. C
  76. C           PRINT*,'DANS ROTATI:'
  77. C           PRINT*,'EPSILI',(EPSILI(ISTRS),ISTRS=1,NSTRS1)
  78. C           PRINT*,'EPIN0',(EPIN0(ISTRS),ISTRS=1,NSTRS1)
  79.             IF (IFOUR.EQ.-2) THEN
  80.              EPSILI(3)=-XMAT(2)/(1.D0-XMAT(2))*(EPSILI(1)+EPSILI(2))
  81.             ENDIF
  82.             DO 100 ISTRS=1,NSTRS1
  83.              EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
  84. 100         CONTINUE
  85. C
  86. C      appel a la routine ROTAT2
  87. C
  88. *           PRINT*,'DEPSIL=DEPST',(DEPST(ISTRS),ISTRS=1,NSTRS1)
  89.             CALL  COTAT2 (wrk52,wrk53,wrk54,WRKK2,NSTRS1,NVARI,ICARA)
  90.          ELSE
  91.              print*,'erreur dans invalm'
  92.              KERRE=56
  93.          END IF
  94.       ELSE
  95.          print*,'erreur dans dohmas'
  96.          KERRE=56
  97.       END IF
  98.       SEGSUP WRKK2
  99.       RETURN
  100.       END
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  

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