Télécharger defmat.eso

Retour à la liste

Numérotation des lignes :

  1. C DEFMAT SOURCE BP208322 17/03/01 21:16:57 9325
  2. SUBROUTINE DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  3. . IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  4. . WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,
  5. . XMOB,BID,BID2,KERR0)
  6. *
  7. *********************************************************
  8. * ENTREES
  9. *********************************************************
  10. *
  11. * NMATT : nombre de composantes matériau
  12. * NSTRS : nombre de composantes des contraintes
  13. * MFR : formulation de l'élément
  14. * INPLAS : numéro du matériau inélastique
  15. * IVAMAT : pointeur sur un segment mptval de materiau
  16. * IB : numéro de l'élément
  17. * IGAU : numéro du point de Gauss
  18. * CMATE : nom du matériau
  19. * MATE : numéro du matériau
  20. * LUNI1 : booléen pour le matériau ACIER_UNI
  21. * LUNI2 : booléen pour le matériau ACIER_UNI
  22. * TXR : cosinus directeur des axes locaux pour l'ACIER_UNI
  23. * (WTRAV)
  24. *
  25. *********************************************************
  26. * SORTIES
  27. *********************************************************
  28. *
  29. * SIG0 : contraintes effectives (WRK1)
  30. * EPST0 : deformations totales au debut du pas (WRK5)
  31. * XMAT : composantes matériaux (WRK0)
  32. * CMASS : élément de réduction de la masse
  33. * CRIGI : élément de réduction de la rigidité
  34. * TYMAT : type des composantes materiau (WR00)
  35. * COB : porosité (éventuelle)
  36. * BID :
  37. * BID2 :
  38. * KERR0 : indicateur d'erreur
  39. *
  40. *********************************************************
  41. *
  42. IMPLICIT INTEGER(I-N)
  43. IMPLICIT REAL*8(A-H,O-Z)
  44. *
  45. -INC CCOPTIO
  46. -INC SMCHAML
  47. -INC SMLREEL
  48. *
  49. SEGMENT MPTVAL
  50. INTEGER IPOS(NS) ,NSOF(NS)
  51. INTEGER IVAL(NCOSOU)
  52. CHARACTER*16 TYVAL(NCOSOU)
  53. ENDSEGMENT
  54. *
  55. SEGMENT WRK0
  56. REAL*8 XMAT(NCXMAT)
  57. ENDSEGMENT
  58. *
  59. SEGMENT WR00
  60. CHARACTER*16 TYMAT(NCXMAT)
  61. REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  62. ENDSEGMENT
  63. *
  64. SEGMENT WRK1
  65. REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  66. REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  67. REAL*8 DEFP(NSTRS),XCAR(ICARA)
  68. ENDSEGMENT
  69. *
  70. SEGMENT WRK5
  71. REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  72. ENDSEGMENT
  73. *
  74. SEGMENT WTRAV
  75. REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  76. REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  77. REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  78. REAL*8 XLOC(3,3),XGLOB(3,3)
  79. REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  80. ENDSEGMENT
  81. *
  82. DIMENSION CRIGI(12),CMASS(12)
  83. DIMENSION BID(*),BID2(*)
  84. LOGICAL LUNI1,LUNI2
  85. CHARACTER*8 CMATE
  86. *
  87. * on recupere les constantes du materiau
  88. *
  89. *
  90. * >>>>>>>>>> cas des materiaux orthotropes plastiques decouples
  91. *
  92. c mistral :
  93. IF ((INPLAS.EQ.67).OR.(INPLAS.EQ.68).OR.(INPLAS.EQ.94)) THEN
  94. c mistral.
  95. MPTVAL=IVAMAT
  96. DO IC=1,NMATT
  97. MELVAL=IVAL(IC)
  98. IAUX=MELVAL
  99. IF(IAUX.NE.0) THEN
  100. IF(TYVAL(IC)(1:8).NE.'POINTEUR') THEN
  101. IBMN=MIN(IB,VELCHE(/2))
  102. IGMN=MIN(IGAU,VELCHE(/1))
  103. XMAT(IC)=VELCHE(IGMN,IBMN)
  104. ELSE
  105. IBMN=MIN(IB,IELCHE(/2))
  106. IGMN=MIN(IGAU,IELCHE(/1))
  107. XMAT(IC)=IELCHE(IGMN,IBMN)
  108. ENDIF
  109. ELSE
  110. XMAT(IC)=0.D0
  111. IF(TYVAL(IC)(1:8).EQ.'POINTEUR') XMAT(IC)=0
  112. ENDIF
  113. END DO
  114. GOTO 1000
  115. ENDIF
  116. *
  117. * >>>>>>>>>> cas du SIC_SIC
  118. *
  119. IF (INPLAS.EQ.88) THEN
  120. MPTVAL=IVAMAT
  121. DO IC=1,NMATT
  122. MELVAL=IVAL(IC)
  123. IAUX=MELVAL
  124. IF(IAUX.NE.0) THEN
  125. IF(TYVAL(IC)(1:8).NE.'POINTEUR') THEN
  126. IBMN=MIN(IB,VELCHE(/2))
  127. IGMN=MIN(IGAU,VELCHE(/1))
  128. XMAT(IC)=VELCHE(IGMN,IBMN)
  129. ELSE
  130. IBMN=MIN(IB,IELCHE(/2))
  131. IGMN=MIN(IGAU,IELCHE(/1))
  132. XMAT(IC)=IELCHE(IGMN,IBMN)
  133. ENDIF
  134. ELSE
  135. XMAT(IC)=0.D0
  136. IF(TYVAL(IC)(1:8).EQ.'POINTEUR') XMAT(IC)=0
  137. ENDIF
  138. END DO
  139. GOTO 1000
  140. ENDIF
  141. *
  142. * cas des poutres en formulation section
  143. *
  144. IF ((MFR.EQ.7.OR.MFR.EQ.13).AND.
  145. 1 CMATE.EQ.'SECTION') THEN
  146. MPTVAL=IVAMAT
  147. DO IC=1,NMATT
  148. MELVAL=IVAL(IC)
  149. IAUX=MELVAL
  150. IF(IAUX.NE.0)THEN
  151. IBMN=MIN(IB,IELCHE(/2))
  152. IGMN=MIN(IGAU,IELCHE(/1))
  153. XMAT(IC)=DBLE(IELCHE(IGMN,IBMN))
  154. IF(IC.EQ.1) IPM=IELCHE(IGMN,IBMN)
  155. IF(IC.EQ.2) IPC=IELCHE(IGMN,IBMN)
  156. ELSE
  157. XMAT(IC)=DBLE(0)
  158. ENDIF
  159. END DO
  160. IF (INPLAS.EQ.0) THEN
  161. MLREEL = NINT(XMAT(3))
  162. IF(MLREEL.EQ.0)THEN
  163. CALL FRIGIE(IPM,IPC,CRIGI,CMASS)
  164. ELSE
  165. SEGACT, MLREEL
  166. CALL BIFLX1(PROG(1),NSTRS,CRIGI)
  167. SEGDES, MLREEL
  168. ENDIF
  169. ENDIF
  170. *
  171. * >>>>>>>>>> cas des materiaux elastiques isotropes
  172. * ou unidirectionnels
  173. ELSE IF(MATE.EQ.1.OR.MATE.EQ.4) THEN
  174. MPTVAL=IVAMAT
  175. IF(INPLAS.EQ. 9.OR.INPLAS.EQ.28.OR.INPLAS.EQ.36.
  176. & OR.INPLAS.EQ.42.OR.INPLAS.EQ.65.
  177. & OR.INPLAS.EQ.66.OR.INPLAS.EQ.74) THEN
  178. *
  179. * pour les modeles beton et ubiquitous
  180. * et ceux dont on ne remodifie pas l'ordre
  181. *
  182. DO 1105 IC=1,NMATT
  183. MELVAL=IVAL(IC)
  184. IAUX=MELVAL
  185. IF(IAUX.NE.0)THEN
  186. IF(VELCHE(/1)+VELCHE(/2).NE.0) THEN
  187. IBMN=MIN(IB,VELCHE(/2))
  188. IGMN=MIN(IGAU,VELCHE(/1))
  189. XMAT(IC)=VELCHE(IGMN,IBMN)
  190. ELSE IF(IELCHE(/1)+IELCHE(/2).NE.0) THEN
  191. IBMN=MIN(IB ,IELCHE(/2))
  192. IGMN=MIN(IGAU,IELCHE(/1))
  193. XMAT(IC)=DBLE(IELCHE(IGMN,IBMN))
  194. ENDIF
  195. ELSE
  196. XMAT(IC)=0.D0
  197. ENDIF
  198. * print *,'defmat XMAT(',IC,')=',XMAT(IC)
  199. 1105 continue
  200. *
  201. ELSE
  202. *
  203. * pour les autres modeles :
  204. * on a les noms : e,nu,puis le reste des obligatoires
  205. * puis les facultatives qui se terminent par rho et alph
  206. * d'apres un rangement dans idmatr
  207. * dans le remplissage de xmat, on veut e,nu,rho,alph
  208. * puis la suite. d'ou ce qui suit ....
  209. * am 9/11/93 a reprendre !!
  210. * am 28/7/95 le commentaire ci dessus est FAUX si l'on a des
  211. * proprietes facultatives en plus de rho et alph
  212. * car dans ce cas les facultatives COMMENCENT par
  213. * rho et alph. a reprendre !!!!!!!!
  214. *
  215. DO 1106 IC=1,NMATT
  216. IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31
  217. + .OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  218. IF(IC.LE.2.OR.IC.EQ.NMATT) JC=IC
  219. IF(IC.GT.2.AND.IC.LT.NMATT-2) JC=IC+2
  220. IF(IC.EQ.NMATT-2) JC=3
  221. IF(IC.EQ.NMATT-1) JC=4
  222. C
  223. ELSEIF(MFR.EQ.53)THEN
  224. III=1
  225. IF(IC.LE.III.OR.IC.EQ.NMATT) JC=IC
  226. IF(IC.GT.III.AND.IC.LT.NMATT-2) JC=IC+2
  227. IF(IC.EQ.NMATT-2) JC=III+1
  228. IF(IC.EQ.NMATT-1) JC=III+2
  229.  
  230. ELSE
  231. IF(IC.LE.2) JC=IC
  232. IF(IC.GT.2.AND.IC.LT.NMATT-1) JC=IC+2
  233. IF(IC.EQ.NMATT-1) JC=3
  234. IF(IC.EQ.NMATT) JC=4
  235. ENDIF
  236. MELVAL=IVAL(IC)
  237. IAUX=MELVAL
  238. IF(IAUX.NE.0)THEN
  239. IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  240. IBMN=MIN(IB,VELCHE(/2))
  241. IGMN=MIN(IGAU,VELCHE(/1))
  242. XMAT(JC)=VELCHE(IGMN,IBMN)
  243. TYMAT(JC)=TYVAL(IC)
  244. ELSE
  245. IBMN=MIN(IB,IELCHE(/2))
  246. IGMN=MIN(IGAU,IELCHE(/1))
  247. XMAT(JC)=IELCHE(IGMN,IBMN)
  248. TYMAT(JC)=TYVAL(IC)
  249. ENDIF
  250. ELSE
  251. XMAT(JC)=0.D0
  252. TYMAT(JC)='REAL*8 '
  253. ENDIF
  254. * PRINT *,'XMAT(',JC,')=',XMAT(JC)
  255. 1106 continue
  256. *
  257. * rearrangement pour certaines lois cas elastique isotrope
  258. *
  259. IF(INPLAS.EQ.64) THEN
  260. C gurson2
  261. XSRMA=XMAT(3)
  262. XMAT(3)=XMAT(17)
  263. XMAT(17)=XMAT(4)
  264. XMAT(4)=XSRMA
  265. ENDIF
  266. C IF (INPLAS.EQ.7) THEN
  267. * chaboche 1
  268. C IF(XMAT(10).NE.0.OR.XMAT(11).NE.0)THEN
  269. C INPLAS=8
  270. C ENDIF
  271. IF (INPLAS.EQ.2) THEN
  272. IF (XMAT(6).NE.0) THEN
  273. INPLAS=27
  274. XMAT(5)=XMAT(6)
  275. ENDIF
  276. ENDIF
  277. C IF (INPLAS.EQ.12) THEN
  278. * chaboche 2
  279. C IF(XMAT(12).NE.0.OR.XMAT(13).NE.0)THEN
  280. C INPLAS=13
  281. C ENDIF
  282. IF (INPLAS.EQ.14) THEN
  283. IF(XMAT(8).NE.0.OR.XMAT(9).NE.0)THEN
  284. INPLAS=18
  285. XMAT(5)=XMAT(8)
  286. XMAT(6)=XMAT(9)
  287. ENDIF
  288. ENDIF
  289. ENDIF
  290. *
  291. * rearrangement pour certaines formulations
  292. *
  293. * milieu poreux cas elastique isotrope
  294. *
  295. IF (MFR.EQ.33) THEN
  296. IF(IFOUR.EQ.-3.OR.IFOUR.EQ.1) THEN
  297. KERR0=99
  298. GO TO 1000
  299. ENDIF
  300. COB=XMAT(5)
  301. XMOB=XMAT(6)
  302. DO 1992 IC=1,NMATT-12
  303. XMAT(4+IC)=XMAT(6+IC)
  304. 1992 continue
  305. *
  306. * calcul des contraintes effectives
  307. *
  308. DO 1993 IC=1,3
  309. IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1993
  310. SIG0(IC) =SIG0(IC) + COB* EPST0(NSTRS)
  311. 1993 continue
  312. ENDIF
  313. *
  314. * rearrangement pour les materiaux unidirectionnels
  315. * en plasticite
  316. *
  317. * ce qui suit est limité au coq2 et au dst
  318. *
  319. * on met v1x et v1y à la place de rho et alph
  320. * on met nu à 0. et on se decale ( on ignore les axes )
  321. *
  322. * dans le cas des coq2, il faut aller chercher les contraintes
  323. * dans la direction ad-hoc. inutile pour le dst.
  324. * on se limite au cas axisymetrique ?
  325. *
  326. IF (MATE.EQ.4.AND.INPLAS.NE.0.AND.INPLAS.NE.74) THEN
  327. * ppu if(mele.ne.44.and.mele.ne.93) go to 1000
  328. XMAT(3)=XMAT(2)
  329. XMAT(2)=0.D0
  330. DO 1995 IC=4,NMATT-1
  331. XMAT(IC) = XMAT(IC+1)
  332. 1995 CONTINUE
  333. *
  334. * coq2 : on change les contraintes de repere
  335. * les variables internes sont dans le repere unidirectionnel
  336. *
  337. IF (MELE.EQ.44) THEN
  338. DO 1996 I=1,NSTRS
  339. BID(I)=SIG0(I)
  340. BID2(I)=DSIGT(I)
  341. 1996 CONTINUE
  342. *
  343. ELSEIF(LUNI1)THEN
  344. V1X=TXR(1,1)*XMAT(3)+TXR(1,2)*XMAT(4)
  345. V1Y=TXR(2,1)*XMAT(3)+TXR(2,2)*XMAT(4)
  346. XMAT(3)=V1X
  347. XMAT(4)=V1Y
  348. ELSEIF(LUNI2)THEN
  349. ELSE
  350. GOTO 1000
  351. *
  352. ENDIF
  353. ENDIF
  354. *
  355. ENDIF
  356. *
  357. * >>>>>>>>>> fin du traitement du materiau
  358. *
  359. 1000 RETURN
  360. END
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382.  

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