Télécharger mazzz.eso

Retour à la liste

Numérotation des lignes :

  1. C MAZZZ SOURCE CHAT 05/01/13 01:38:25 5004
  2. SUBROUTINE MAZZZ(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,ISTEP,
  3. 1 ICARA,KERRE,MFR)
  4. C
  5. C calcule la deformation initiale et l'increment de deformation
  6. C a partir de la contrainte initiale et l'increment de contrainte
  7. C elastique puis appelle la subroutine MAZARS
  8. C
  9. C
  10. C variables en entree
  11. C
  12. C WRK0,KRK1,WRK5 pointeurs sur des segments de travail
  13. C
  14. C NSTRS nombre de composantes dans les vecteurs des contraintes
  15. C et les vecteurs des deformations
  16. C
  17. C NVARI nombre de variables internes (doit etre egal a 2)
  18. C
  19. C NMATT nombre de constantes du materiau
  20. C
  21. C ISTEP flag utilise pour separer les etapes dans un calcul non local
  22. C ISTEP=0 -----> calcul local
  23. C ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
  24. C ISTEP=2 -----> calcul non local etape 2 on continue le calcul
  25. C a partir des seuils moyennes
  26. C
  27. C
  28. C variables en sortie
  29. C
  30. C VARF variables internes finales dans WRK0
  31. C
  32. C SIGF contraintes finales dans WRK0
  33. C
  34. C Modif L.Bode - 09/10/92 - Traitement particulier des coques
  35. C Modif L.Bode - 14/10/92 - Modifications complementaires
  36. C
  37. IMPLICIT INTEGER(I-N)
  38. IMPLICIT REAL*8(A-H,O-Z)
  39. -INC CCOPTIO
  40. SEGMENT WRK0
  41. REAL*8 XMAT(NMATT)
  42. ENDSEGMENT
  43. *
  44. SEGMENT WRK1
  45. REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  46. REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  47. REAL*8 DEFP(NSTRS),XCAR(ICARA)
  48. ENDSEGMENT
  49. SEGMENT WRKK2
  50. REAL*8 EPSILI(NSTRSV),DSIGT(NSTRSV)
  51. END SEGMENT
  52. *
  53. SEGMENT WRK5
  54. REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  55. ENDSEGMENT
  56. SEGMENT WRK6
  57. REAL*8 SIG0S(NSTRS),DEPSTS(NSTRS)
  58. END SEGMENT
  59. *
  60. CHARACTER*8 CMATE
  61. INTEGER NSTRS,NVARI,NMATT
  62. INTEGER KCAS,IRTD,ISTRS,KERRE,MFR
  63. REAL*8 PREC,EPAI,FAC,AUX,AUX1,AUX2,YOUN,XNU
  64. REAL*8 UN
  65. PARAMETER (UN=1.D0)
  66. KERRE=0
  67. YOUN = XMAT(1)
  68. XNU = XMAT(2)
  69. C
  70. C ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
  71. C
  72. C print*,'dans mazzzz MFR=', mfr
  73. IF (MFR .EQ. 9) THEN
  74. EPAI=XCAR(1)
  75. SEGINI WRK6
  76. DO 101 ISTRS=1,NSTRS
  77. SIG0S(ISTRS)=SIG0(ISTRS)
  78. DEPSTS(ISTRS)=DEPST(ISTRS)
  79. 101 CONTINUE
  80. NSTRSV=4
  81. IFOUR2=-2
  82. C Modif L.Bode - 14/10/92
  83. C Dans le cas des coques, on force la dimension a 2 pour MAZARS
  84. C ie on travaille en contraintes planes
  85. JDIM =2
  86. C Fin modif L.Bode
  87. DO 102 ISTRS=1,2
  88. SIG0(ISTRS)=SIG0S(ISTRS)/EPAI
  89. 102 CONTINUE
  90. DEPST(3)=0.D0
  91. DEPST(4)=DEPSTS(3)
  92. SIG0(3)=0.D0
  93. SIG0(4)=SIG0S(3)/EPAI
  94. ELSE IF (MFR .EQ. 1) THEN
  95. NSTRSV=NSTRS
  96. IFOUR2=IFOUR
  97. C Modif L.Bode - 14/10/92
  98. C Pour les elts massifs, on utilise la vraie dimension
  99. JDIM = IDIM
  100. C Fin modif L.Bode
  101. ELSE
  102. PRINT*,'MFR=',MFR
  103. KERRE=57
  104. RETURN
  105. END IF
  106. SEGINI WRKK2
  107.  
  108.  
  109. C
  110. C calcul de la matrice elastique
  111. C
  112. CMATE = 'ISOTROPE'
  113. KCAS=1
  114. * print*,'increment de deformation elastique'
  115. CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
  116. * DO ISTRS=1,NSTRS
  117. * print*,(DDHOOK(ISTRS,J),j=1,nstrs)
  118. * print*,DEPST(ISTRS)
  119. * END DO
  120. IF ( IRTD .EQ. 1) THEN
  121. C
  122. C calcul de l'increment de contrainte
  123. C
  124. CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
  125. C
  126. C
  127. C inversion de cette matrice
  128. C
  129. PREC=1.D-08
  130. CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,2,DDHOOK,IRTD)
  131. * DO ISTRS=1,NSTRSV
  132. * print*,(DDHOOK(ISTRS,J),j=1,nstrsv)
  133. * END DO
  134. * print*,'appel a invalm'
  135. CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
  136. IF (IRTD.EQ.0)THEN
  137. C
  138. C calcul des deformations du materiau elastique lineaire
  139. C
  140. * print*,'appel a matve1'
  141. CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
  142. C
  143. C modification pour tenir compte de l'endommagement
  144. C
  145. DO 100 ISTRS=1,NSTRSV
  146. EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
  147. 100 CONTINUE
  148.  
  149. C
  150. C appel a la routine MAZARS
  151. C
  152. C Modif L.Bode - 14/10/92
  153. C On envoie la dimension et le numero de la formulation
  154. C ( Elts Coques JDIM =2 , IFOUR2 = -2 => contraintes planes
  155. C Elts Massifs JDIM = IDIM ,IFOUR2 = IFOUR)
  156. * print*,'appel a mazars'
  157. CALL MAZARS (WRK0,WRK1,WRKK2,WRK5,NSTRSV,NVARI,NMATT,
  158. 1 ISTEP,ICARA,JDIM,IFOUR2)
  159. C Fin modif L.Bode
  160. C
  161. C ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
  162. C
  163. * print*,'apres mazars'
  164. IF (MFR .EQ. 9) THEN
  165.  
  166.  
  167. C
  168. C ON MET A JOUR DE FACON NON LINEAIRE LA PARTIE MEMBRANE
  169. C ET LES PARTIES FLEXION ET EFFORTS
  170. C TRANCHANTS LE CAS ECHEANT
  171. C
  172. FAC=(EPAI**3)/12.D0
  173. AUX =FAC*YOUN/(1.D0-XNU*XNU)
  174. AUX1=FAC*YOUN*.5D0/(1.D0+XNU)
  175. AUX2=EPAI*YOUN*.5D0/(1.d0+XNU)/1.2d0
  176. DO 103 ISTRS=1,NSTRS
  177. SIG0(ISTRS)=SIG0S(ISTRS)
  178. DEPST(ISTRS)=DEPSTS(ISTRS)
  179. 103 CONTINUE
  180.  
  181. DO 104 ISTRS=1,2
  182. SIGF (ISTRS)=SIGF(ISTRS)*EPAI
  183. 104 CONTINUE
  184. SIGF(3)=SIGF(4)*EPAI
  185. SIGF(4)=SIG0(4)+AUX*(DEPST(4)+XNU*DEPST(5))
  186. SIGF(5)=SIG0(5)+AUX*(DEPST(5)+XNU*DEPST(4))
  187. SIGF(6)=SIG0(6)+AUX1*DEPST(6)
  188. SIGF(7)=SIG0(7)+AUX2*DEPST(7)
  189. SIGF(8)=SIG0(8)+AUX2*DEPST(8)
  190. SEGSUP WRK6
  191. END IF
  192. ELSE
  193. print*,'erreur dans invalm'
  194. KERRE=56
  195. END IF
  196. ELSE
  197. print*,'erreur dans dohmas'
  198. KERRE=56
  199. END IF
  200. SEGSUP WRKK2
  201. RETURN
  202. END
  203.  
  204.  
  205.  
  206.  

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