Télécharger cmazzz.eso

Retour à la liste

Numérotation des lignes :

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

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