Télécharger la plaquette Cast3M


fr en

Télécharger rotati.eso

Retour à la liste

Numérotation des lignes : 

rotati

  1. C ROTATI    SOURCE    CHAT      05/01/13    03:05:11     5004
  2. C MAZZZ     SOURCE    AM        92/09/30    21:43:12     712
  3.       SUBROUTINE ROTATI(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,
  4.      1                                           ISTEP,ICARA,KERRE)
  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     NSTRS      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.       SEGMENT WRK0
  40.         REAL*8 XMAT(NMATT)
  41.       ENDSEGMENT
  42. *
  43.       SEGMENT WRK1
  44.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  45.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  46.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  47.       ENDSEGMENT
  48.       SEGMENT WRKK2
  49.          REAL*8 EPSILI(NSTRS)
  50.       END SEGMENT
  51.       SEGMENT WRK5
  52.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  53.       ENDSEGMENT
  54.       CHARACTER*8 CMATE
  55.       INTEGER NSTRS,NVARI,NMATT
  56.       INTEGER KCAS,IRTD,ISTRS,KERRE
  57.       REAL*8 PREC
  58.       REAL*8 UN
  59.       PARAMETER (UN=1.D0)
  60.       KERRE=0
  61. C
  62. C     calcul de la matrice elastique
  63. C
  64.       CMATE = 'ISOTROPE'
  65.       KCAS=1
  66.       CALL DOHMAS(XMAT,CMATE,IFOUR,NSTRS,KCAS,DDHOOK,IRTD)
  67.       IF ( IRTD .EQ. 1) THEN
  68. C
  69. C     inversion de cette matrice
  70. C
  71.          PREC=1.D-08
  72.          SEGINI WRKK2
  73.          IF (IFOUR.EQ.-2) THEN
  74.            CALL INVALM(DDHOOK,NSTRS,2,IRTD,PREC)
  75.            DDHOOK(4,4)=1/DDHOOK(4,4)
  76.          ELSE
  77.            CALL INVALM(DDHOOK,NSTRS,NSTRS,IRTD,PREC)
  78.          ENDIF
  79.          IF (IRTD.EQ.0)THEN
  80. C
  81. C     calcul des deformations du materiau elastique lineaire
  82. C
  83.             CALL MATVE1 (DDHOOK,SIG0,NSTRS,NSTRS,EPSILI,1)
  84. C
  85. C     modification pour tenir compte de l'endommagement
  86. C
  87. C           PRINT*,'DANS ROTATI:'
  88. C           PRINT*,'EPSILI',(EPSILI(ISTRS),ISTRS=1,NSTRS)
  89. C           PRINT*,'EPIN0',(EPIN0(ISTRS),ISTRS=1,NSTRS)
  90.             IF (IFOUR.EQ.-2) THEN
  91.              EPSILI(3)=-XMAT(2)/(1.D0-XMAT(2))*(EPSILI(1)+EPSILI(2))
  92.             ENDIF
  93.             DO 100 ISTRS=1,NSTRS
  94.              EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
  95. 100         CONTINUE
  96. C
  97. C      appel a la routine ROTAT2
  98. C
  99. *           PRINT*,'DEPSIL=DEPST',(DEPST(ISTRS),ISTRS=1,NSTRS)
  100.             CALL  ROTAT2 (WRK0,WRK1,WRKK2,WRK5,NSTRS,NVARI,NMATT,
  101.      1                                                 ISTEP,ICARA)
  102.          ELSE
  103.              print*,'erreur dans invalm'
  104.              KERRE=56
  105.          END IF
  106.       ELSE
  107.          print*,'erreur dans dohmas'
  108.          KERRE=56
  109.       END IF
  110.       SEGSUP WRKK2
  111.       RETURN
  112.       END
  113.  
  114.  
  115.  
  116.  

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