Télécharger rotati.eso

Retour à la liste

Numérotation des lignes :

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

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