Télécharger cmazzz.eso

Retour à la liste

Numérotation des lignes :

cmazzz
  1. C CMAZZZ SOURCE PV 17/12/08 21:16:04 9660
  2. SUBROUTINE CMAZZZ(WRK52,WRK53,WRK54,WRKK2,NVARI,Iecou)
  3. C MAZZZ SOURCE AM 98/12/23 21:39:16 3409
  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 WRKK2 pointeur recycle et ajusté le cas échéant
  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. C
  35. C Modif L.Bode - 09/10/92 - Traitement particulier des coques
  36. C Modif L.Bode - 14/10/92 - Modifications complementaires
  37. C
  38. c KICH XCARB<- XCAR , CMAZAR <- MAZARS
  39.  
  40. IMPLICIT INTEGER(I-N)
  41. IMPLICIT REAL*8(A-H,O-Z)
  42.  
  43. -INC PPARAM
  44. -INC CCOPTIO
  45. -INC DECHE
  46. *
  47. SEGMENT IECOU
  48. * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  49. INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  50. C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK,
  51. 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  52. C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND,
  53. 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  54. C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT,
  55. 3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA,
  56. C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA,
  57. 4 icow32,icow33,NSTRS1,MFR1,icow36,icow37,icow38,
  58. C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA,
  59. 5 icow39,icow40,icow41,icow42,icow43,icow44
  60. C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME
  61. INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  62. . icow51,icow52,icow53,icow54,icow55,icow56
  63. . icow57,icow58
  64. ENDSEGMENT
  65.  
  66.  
  67. SEGMENT WRKK2
  68. REAL*8 EPSILI(NSTRSV)
  69. REAL*8 EPSILO(NSTRSV)
  70. ENDSEGMENT
  71. *
  72. * SEGMENT WRK6
  73. * REAL*8 SIG0S(NSTRS),DEPSTS(NSTRS)
  74. * ENDSEGMENT
  75. REAL*8 SIG0S(9),DEPSTS(9)
  76. *
  77. INTEGER NVARI
  78. INTEGER KCAS,IRTD,ISTRS
  79. REAL*8 PREC,EPAI,FAC,AUX,AUX1,AUX2,YOUN,XNU
  80. REAL*8 UN
  81. PARAMETER (UN=1.D0)
  82. KERRE=0
  83. YOUN = XMAT(1)
  84. XNU = XMAT(2)
  85. C
  86. C ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
  87. C
  88. C print*,'dans mazzzz MFR1=', mfr1
  89. IF (MFR1 .EQ. 9) THEN
  90. EPAI=XCARB(1)
  91. if (nstrs.gt.9) call erreur(5)
  92. ** SEGINI WRK6
  93. DO 101 ISTRS=1,NSTRS1
  94. SIG0S(ISTRS)=SIG0(ISTRS)
  95. DEPSTS(ISTRS)=DEPST(ISTRS)
  96. 101 CONTINUE
  97. NSTRSV=4
  98. IFOUR2=-2
  99. C Modif L.Bode - 14/10/92
  100. C Dans le cas des coques, on force la dimension a 2 pour MAZARS
  101. C ie on travaille en contraintes planes
  102. JDIM =2
  103. C Fin modif L.Bode
  104. DO 102 ISTRS=1,2
  105. SIG0(ISTRS)=SIG0S(ISTRS)/EPAI
  106. 102 CONTINUE
  107. DEPST(3)=0.D0
  108. DEPST(4)=DEPSTS(3)
  109. SIG0(3)=0.D0
  110. SIG0(4)=SIG0S(3)/EPAI
  111.  
  112. ELSE IF (MFR1 .EQ. 1) THEN
  113. NSTRSV=NSTRS1
  114. IFOUR2=IFOUR
  115. C Modif L.Bode - 14/10/92
  116. C Pour les elts massifs, on utilise la vraie dimension
  117. JDIM = IDIM
  118. C Fin modif L.Bode
  119.  
  120. ELSE
  121. PRINT*,'MFR1=',MFR1
  122. KERRE=57
  123. RETURN
  124. END IF
  125.  
  126. IF (WRKK2 .EQ. 0) THEN
  127. SEGINI,WRKK2
  128. ELSEIF(WRKK2.EPSILI(/1).NE. NSTRSV)THEN
  129. SEGADJ,WRKK2
  130. ENDIF
  131.  
  132.  
  133. C
  134. C calcul de la matrice elastique
  135. C
  136. CMATE = 'ISOTROPE'
  137. KCAS=1
  138. * print*,'increment de deformation elastique'
  139. CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
  140. * DO ISTRS=1,NSTRS1
  141. * print*,(DDHOOK(ISTRS,J),j=1,nstrs)
  142. * print*,DEPST(ISTRS)
  143. * END DO
  144. IF ( IRTD .EQ. 1) THEN
  145. C
  146. C calcul de l'increment de contrainte
  147. C
  148. CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
  149. C
  150. C
  151. C inversion de cette matrice
  152. C
  153. PREC=1.D-08
  154. CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,2,DDHOOK,IRTD)
  155. * DO ISTRS=1,NSTRSV
  156. * print*,(DDHOOK(ISTRS,J),j=1,nstrsv)
  157. * END DO
  158. * print*,'appel a invalm'
  159. CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
  160. IF (IRTD.EQ.0)THEN
  161. C
  162. C calcul des deformations du materiau elastique lineaire
  163. C
  164. * print*,'appel a matve1'
  165. CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
  166. C
  167. C modification pour tenir compte de l'endommagement
  168. C
  169. DO 100 ISTRS=1,NSTRSV
  170. EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
  171. 100 CONTINUE
  172.  
  173. C
  174. C appel a la routine MAZARS
  175. C
  176. C Modif L.Bode - 14/10/92
  177. C On envoie la dimension et le numero de la formulation
  178. C ( Elts Coques JDIM =2 , IFOUR2 = -2 => contraintes planes
  179. C Elts Massifs JDIM = IDIM ,IFOUR2 = IFOUR)
  180. * print*,'appel a mazars'
  181. icarbi=icara
  182. CALL CMAZAR (WRK52,WRK53,WRK54,WRKK2,NSTRSV,NVARI,
  183. 1 ICARbi,JDIM,IFOUR2)
  184. icara=icarbi
  185. C Fin modif L.Bode
  186. C
  187. C ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
  188. C
  189. * print*,'apres mazars'
  190. IF (MFR1 .EQ. 9) THEN
  191.  
  192.  
  193. C
  194. C ON MET A JOUR DE FACON NON LINEAIRE LA PARTIE MEMBRANE
  195. C ET LES PARTIES FLEXION ET EFFORTS
  196. C TRANCHANTS LE CAS ECHEANT
  197. C
  198. FAC=(EPAI**3)/12.D0
  199. AUX =FAC*YOUN/(1.D0-XNU*XNU)
  200. AUX1=FAC*YOUN*.5D0/(1.D0+XNU)
  201. AUX2=EPAI*YOUN*.5D0/(1.d0+XNU)/1.2d0
  202. DO 103 ISTRS=1,NSTRS1
  203. SIG0(ISTRS)=SIG0S(ISTRS)
  204. DEPST(ISTRS)=DEPSTS(ISTRS)
  205. 103 CONTINUE
  206.  
  207. DO 104 ISTRS=1,2
  208. SIGF (ISTRS)=SIGF(ISTRS)*EPAI
  209. 104 CONTINUE
  210. SIGF(3)=SIGF(4)*EPAI
  211. SIGF(4)=SIG0(4)+AUX*(DEPST(4)+XNU*DEPST(5))
  212. SIGF(5)=SIG0(5)+AUX*(DEPST(5)+XNU*DEPST(4))
  213. SIGF(6)=SIG0(6)+AUX1*DEPST(6)
  214. SIGF(7)=SIG0(7)+AUX2*DEPST(7)
  215. SIGF(8)=SIG0(8)+AUX2*DEPST(8)
  216. ** SEGSUP WRK6
  217. END IF
  218. ELSE
  219. print*,'erreur dans invalm'
  220. KERRE=56
  221. END IF
  222. ELSE
  223. print*,'erreur dans dohmas'
  224. KERRE=56
  225. ENDIF
  226.  
  227. RETURN
  228. END
  229.  
  230.  
  231.  
  232.  

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