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

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