Télécharger betokt.eso

Retour à la liste

Numérotation des lignes :

  1. C BETOKT SOURCE PV 11/03/07 21:15:10 6885
  2. SUBROUTINE BETOKT(XMAT,TRAC,VARF,SIGF,NCURVT,NCURVC,XKTAT,KERRE)
  3. C
  4. C Matrice tangente pour le modele endommageable en cyclique
  5. C D. Combescure 18/09/95 ELSA-Ispra
  6. C
  7. C ENTREES:
  8. C -------
  9. C XMAT = Caracteristiques materiaux
  10. C
  11. C VARF = Variables internes
  12. C
  13. C SIGF = Contraintes
  14. C
  15. C SORTIES:
  16. C -------
  17. C XKTAT = Matrice tangente
  18. C
  19. C================================================================
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. DIMENSION XMAT(*)
  26. DIMENSION TRAC(*)
  27. C
  28. DIMENSION VARF(14),SIGF(4),EPSI(2),FG(2)
  29. DIMENSION XNOR1(4),XNOR2(4),XCOU1(3,3),XCOU2(3,3)
  30. DIMENSION GAMBDA(2),EEE(2,2),SIGP(2),EEE2(2,2)
  31. DIMENSION UUU(3,2),VVV(2,3),UUU2(3,2),VVV2(2,3),UUU3(3,2)
  32. DIMENSION HHH1(3,3),HHH2(3,3),HHH3(3,3)
  33. DIMENSION XKTAT(4,4),RESIST(6),XKISO(2)
  34. PARAMETER (UN=1.D0,UNDEMI=0.5D0,EPSILO=1.D-20,XZER=0.D0)
  35. PARAMETER (PRECIS=1.D-4)
  36. KERRE=0
  37. C================================================================
  38. C LECTURE DES CARACTERISTIQUES MAT. ET DES VAR. INT.
  39. C===============================================================
  40. C Pour la lecture des courbes
  41. IPT = 1
  42. IPC = IPT+2*NCURVT
  43. C
  44. YOUN = XMAT(1)
  45. XNU = XMAT(2)
  46. XGGG = (UNDEMI*YOUN/(UN+XNU))
  47. XHH1 = XMAT(3)
  48. DEGRAD = XMAT(8)/XMAT(9)
  49. RESIST(1) = XMAT(4)
  50. RESIST(2) = XMAT(4)
  51. RESIST(3) = XMAT(5)
  52. RESIST(4) = XMAT(5)
  53. RESIST(5) = XMAT(6)
  54. RESIST(6) = XMAT(7)
  55. XLCAT = XMAT(10)
  56. XLCAC = XMAT(11)
  57. CPHI = VARF(5) + UN
  58. SPHI = VARF(6)
  59. EPSI(1) = VARF(3)
  60. EPSI(2) = VARF(4)
  61. ICAS1 = nint(VARF(11))
  62. ICAS2 = nint(VARF(12))
  63. C==============================================================
  64. C RAIDEUR ELASTIQUE
  65. C===============================================================
  66. CALL ZERO(XKTAT,4,4)
  67. XKTAT(1,1) = YOUN/(UN - (XNU**2))
  68. XKTAT(1,2) = XNU*XKTAT(1,1)
  69. XKTAT(2,1) = XKTAT(1,2)
  70. XKTAT(2,2) = XKTAT(1,1)
  71. XKTAT(4,4) = YOUN/(2.D0*(UN+XNU))
  72. C==============================================================
  73. IF (ICAS1.EQ.0) THEN
  74. GOTO 9999
  75. ENDIF
  76. C
  77. CALL VALEUR(EPSI(1),TRAC(IPT),NCURVT,XLCAT,
  78. &XKISO(1),XPEN1,KERRE)
  79. CALL VALEUR(EPSI(2),TRAC(IPC),NCURVC,XLCAC,
  80. &XKISO(2),XPEN2,KERRE)
  81. GAMBDA(1) = VARF(13)
  82. GAMBDA(2) = VARF(14)
  83. IF (ICAS1.LE.4) THEN
  84. FG(1) = RESIST(ICAS1)
  85. ELSE
  86. FG(1) = XKISO(ICAS1-4)*RESIST(ICAS1)
  87. ENDIF
  88. IF (ICAS2.LE.4) THEN
  89. FG(2) = RESIST(ICAS2)
  90. ELSE
  91. FG(2) = XKISO(ICAS2-4)*RESIST(ICAS2)
  92. ENDIF
  93. C==============================================================
  94. C CALCUL DE L'INVERSE
  95. C==============================================================
  96. CALL ZERO(HHH1,3,3)
  97. HHH1(1,1) = UN/YOUN
  98. HHH1(1,2) = -XNU*HHH1(1,1)
  99. HHH1(2,1) = HHH1(1,2)
  100. HHH1(2,2) = HHH1(1,1)
  101. HHH1(3,3) = (2.D0*(UN+XNU)/YOUN)
  102. C
  103. CALL CONPRI (SIGF,CPHI,SPHI,SIGP,CPHI,SPHI)
  104. C
  105. IF (ICAS1.EQ.1) THEN
  106. ISGNTC = 1
  107. ELSE IF (ICAS1.EQ.2) THEN
  108. ISGNTC = 1
  109. ELSE IF (ICAS1.EQ.3) THEN
  110. ISGNTC = -1
  111. ELSE IF (ICAS1.EQ.4) THEN
  112. ISGNTC = -1
  113. ELSE IF (ICAS1.EQ.5) THEN
  114. ISGNTC = 1
  115. ELSE IF (ICAS1.EQ.6) THEN
  116. ISGNTC = -1
  117. ENDIF
  118. IF (ICAS1.LE.4) THEN
  119. IF (SIGP(2).GE.SIGP(1)) THEN
  120. IF ((ICAS1.EQ.1).OR.(ICAS1.EQ.3)) THEN
  121. ISGN2 = -1
  122. ELSE
  123. ISGN2 = 1
  124. ENDIF
  125. ELSE
  126. IF ((ICAS1.EQ.1).OR.(ICAS1.EQ.3)) THEN
  127. ISGN2 = 1
  128. ELSE
  129. ISGN2 = -1
  130. ENDIF
  131. ENDIF
  132. ELSE
  133. ISGN2 = 1
  134. ENDIF
  135. IF (ICAS1.LE.4) THEN
  136. CALL COURBU(SIGF,FG(1),ISGNTC,ISGN2,1,XCOU1)
  137. CALL NORMBL(SIGF,FG(1),ISGNTC,ISGN2,1,XNOR1)
  138. ELSE
  139. PHI = SQRT ((UNDEMI*(SIGF(1)-SIGF(2)))**2+SIGF(4)**2)
  140. IF ((PHI.LT.ABS(PRECIS*FG(1))).AND.(ICAS1.EQ.ICAS2)) THEN
  141. C Cas de l'apex ou on calcule directement H-1
  142. HHH1(1,1) = XGGG*((4.D0*PHI)+(YOUN*GAMBDA(1)))/
  143. & (2.D0*(UN-XNU)*((2.D0*PHI)+(XGGG*GAMBDA(1))))
  144. HHH1(2,2)=HHH1(1,1)
  145. HHH1(1,2) = XGGG*((4.D0*XNU*PHI)+(YOUN*GAMBDA(1)))/
  146. & (2.D0*(UN-XNU)*((2.D0*PHI)+(XGGG*GAMBDA(1))))
  147. HHH1(2,1)=HHH1(1,2)
  148. HHH1(3,3) = XGGG*PHI/(PHI+XGGG*GAMBDA(1))
  149. CALL NORMBL(SIGF,FG(1),ISGNTC,1,2,XNOR1)
  150. GOTO 1010
  151. ELSE
  152. CALL COURBU(SIGF,FG(1),ISGNTC,1,2,XCOU1)
  153. CALL NORMBL(SIGF,FG(1),ISGNTC,1,2,XNOR1)
  154. ENDIF
  155. ENDIF
  156. C
  157. C
  158. IF (ICAS1.EQ.ICAS2) THEN
  159. GOTO 1000
  160. ELSE
  161. IF (ICAS2.LE.4) THEN
  162. FG(2) = RESIST(ICAS2)
  163. ELSE
  164. FG(2) = XKISO(ICAS2-4)*RESIST(ICAS2)
  165. ENDIF
  166. IF (ICAS2.EQ.1) THEN
  167. ISGNTCB = 1
  168. ELSE IF (ICAS2.EQ.2) THEN
  169. ISGNTCB = 1
  170. ELSE IF (ICAS2.EQ.3) THEN
  171. ISGNTCB = -1
  172. ELSE IF (ICAS2.EQ.4) THEN
  173. ISGNTCB = -1
  174. ELSE IF (ICAS2.EQ.5) THEN
  175. ISGNTCB = 1
  176. ELSE IF (ICAS2.EQ.6) THEN
  177. ISGNTCB = -1
  178. ENDIF
  179. IF (ICAS2.LE.4) THEN
  180. IF (SIGP(2).GE.SIGP(1)) THEN
  181. IF ((ICAS2.EQ.1).OR.(ICAS2.EQ.3)) THEN
  182. ISGN2B = -1
  183. ELSE
  184. ISGN2B = 1
  185. ENDIF
  186. ELSE
  187. IF ((ICAS2.EQ.1).OR.(ICAS2.EQ.3)) THEN
  188. ISGN2B = 1
  189. ELSE
  190. ISGN2B = -1
  191. ENDIF
  192. ENDIF
  193. ELSE
  194. ISGN2B = 1
  195. ENDIF
  196. C
  197. IF (ICAS2.LE.4) THEN
  198. CALL COURBU(SIGF,FG(2),ISGNTCB,ISGN2B,1,XCOU2)
  199. CALL NORMBL(SIGF,FG(2),ISGNTCB,ISGN2B,1,XNOR2)
  200. ELSE
  201. CALL COURBU(SIGF,FG(2),ISGNTCB,1,2,XCOU2)
  202. CALL NORMBL(SIGF,FG(2),ISGNTCB,1,2,XNOR2)
  203. ENDIF
  204. C
  205. GOTO 2000
  206. ENDIF
  207. C
  208. C
  209. C
  210. 1000 CONTINUE
  211. C
  212. C Cas 1 mecanisme
  213. C
  214. C Calcul de l'inverse de H et de H
  215. CALL PLMATR(HHH1,UN,XCOU1,GAMBDA(1),3,3,HHH1)
  216. CALL INVALM(HHH1,3,3,IRD,1.D-8)
  217. IF (IRD.NE.0) THEN
  218. WRITE (IOIMP,*)'BETOKT: Determinant nul'
  219. GOTO 9999
  220. ENDIF
  221. C Point d'entree dans le cas de l'apex
  222. 1010 CONTINUE
  223. C Calcul de U,V et E-1
  224. CALL ZERO(UUU,3,2)
  225. CALL ZERO(VVV,2,3)
  226. CALL ZERO(UUU2,3,2)
  227. CALL ZERO(VVV2,2,3)
  228. UUU(1,1) = XNOR1(1)
  229. UUU(2,1) = XNOR1(2)
  230. UUU(3,1) = XNOR1(4)
  231. VVV(1,1) = XNOR1(1)
  232. VVV(1,2) = XNOR1(2)
  233. VVV(1,3) = XNOR1(4)
  234. C
  235. IF (ICAS1.LE.4) THEN
  236. EEE(1,1) = XHH1
  237. ELSE IF (ICAS1.EQ.5) THEN
  238. EEE(1,1) = ISGNTC*XPEN1*RESIST(ICAS1)
  239. ELSE IF (ICAS1.EQ.6) THEN
  240. EEE(1,1) = ISGNTC*XPEN2*RESIST(ICAS1)
  241. ENDIF
  242. C
  243. CALL MATMAT(HHH1,UUU,3,3,2,UUU2)
  244. CALL MATMAT(VVV,HHH1,2,3,3,VVV2)
  245. C
  246. CALL MATMAT(VVV,UUU2,2,3,2,HHH2)
  247. C
  248. EEE(1,1) = EEE(1,1) + HHH2(1,1)
  249. IF (ABS(EEE(1,1)).GT.EPSILO) THEN
  250. EEE(1,1) = -UN/EEE(1,1)
  251. ELSE
  252. WRITE (IOIMP,*)'BETOKT: Determinant nul'
  253. GOTO 9999
  254. ENDIF
  255. CALL MATMAT(UUU2,VVV2,3,2,3,HHH3)
  256. CALL PLMATR(HHH1,UN,HHH3,EEE(1,1),3,3,HHH1)
  257. C
  258. GOTO 3000
  259. C
  260. 2000 CONTINUE
  261. C
  262. C Cas 2 mecanismes
  263. C
  264. C Calcul de H-1 et H
  265. CALL PLMATR(HHH1,UN,XCOU1,GAMBDA(1),3,3,HHH1)
  266. CALL PLMATR(HHH1,UN,XCOU2,GAMBDA(2),3,3,HHH1)
  267. CALL INVALM(HHH1,3,3,IRD,1.D-8)
  268. IF (IRD.NE.0) THEN
  269. WRITE (IOIMP,*)'BETOKT: Determinant nul'
  270. GOTO 9999
  271. ENDIF
  272. C Calcul de U ,V et E
  273. UUU(1,1) = XNOR1(1)
  274. UUU(2,1) = XNOR1(2)
  275. UUU(3,1) = XNOR1(4)
  276. UUU(1,2) = XNOR2(1)
  277. UUU(2,2) = XNOR2(2)
  278. UUU(3,2) = XNOR2(4)
  279. VVV(1,1) = XNOR1(1)
  280. VVV(1,2) = XNOR1(2)
  281. VVV(1,3) = XNOR1(4)
  282. VVV(2,1) = XNOR2(1)
  283. VVV(2,2) = XNOR2(2)
  284. VVV(2,3) = XNOR2(4)
  285. C
  286. IF (ICAS1.LE.4) THEN
  287. EEE(1,1) = XHH1
  288. IF (ICAS2.EQ.6) THEN
  289. EEE(2,1) = DEGRAD*ISGNTCB*RESIST(6)
  290. &*ISGNTC*RESIST(ICAS1)*XPEN2
  291. ELSE
  292. EEE(2,1) = XZER
  293. ENDIF
  294. ELSE IF (ICAS1.EQ.5) THEN
  295. EEE(1,1) = ISGNTC*XPEN1*RESIST(ICAS1)
  296. EEE(2,1) = XZER
  297. ELSE IF (ICAS1.EQ.6) THEN
  298. EEE(1,1) = ISGNTC*XPEN2*RESIST(ICAS1)
  299. EEE(2,1) = XZER
  300. ENDIF
  301. IF (ICAS2.LE.4) THEN
  302. EEE(2,2) = XHH1
  303. IF (ICAS1.EQ.6) THEN
  304. EEE(1,2) = DEGRAD*ISGNTC*RESIST(6)
  305. &*ISGNTCB*RESIST(ICAS2)*XPEN2
  306. ELSE
  307. EEE(1,2) = XZER
  308. ENDIF
  309. ELSE IF (ICAS2.EQ.5) THEN
  310. EEE(2,2) = ISGNTCB*XPEN1*RESIST(ICAS2)
  311. EEE(1,2) = XZER
  312. ELSE IF (ICAS2.EQ.6) THEN
  313. EEE(2,2) = ISGNTCB*XPEN2*RESIST(ICAS2)
  314. EEE(1,2) = XZER
  315. ENDIF
  316. C
  317. CALL MATMAT(HHH1,UUU,3,3,2,UUU2)
  318. CALL MATMAT(VVV,HHH1,2,3,3,VVV2)
  319. C
  320. CALL MATMAT(VVV,UUU2,2,3,2,HHH2)
  321. C
  322. CALL PLMATR(EEE,UN,HHH2,UN,2,2,EEE)
  323. XDET = EEE(1,1)*EEE(2,2) - EEE(1,2)*EEE(2,1)
  324. IF (ABS(XDET).GT.EPSILO) THEN
  325. XDET = UN/XDET
  326. EEE2(1,1) = XDET*EEE(2,2)
  327. EEE2(2,2) = XDET*EEE(1,1)
  328. EEE2(2,1) = -XDET*EEE(1,2)
  329. EEE2(1,2) = -XDET*EEE(2,1)
  330. ELSE
  331. WRITE (IOIMP,*)'BETOKT: Determinant nul'
  332. GOTO 9999
  333. ENDIF
  334. CALL MATMAT(UUU2,EEE2,3,2,2,UUU3)
  335. CALL MATMAT(UUU3,VVV2,3,2,3,HHH3)
  336. CALL PLMATR(HHH1,UN,HHH3,-UN,3,3,HHH1)
  337. C
  338. GOTO 3000
  339. C
  340. C==============================================================
  341. 3000 CONTINUE
  342. CALL ZERO(XKTAT,4,4)
  343. XKTAT(1,1) = HHH1(1,1)
  344. XKTAT(1,2) = HHH1(1,2)
  345. XKTAT(2,1) = HHH1(2,1)
  346. XKTAT(2,2) = HHH1(2,2)
  347. XKTAT(4,4) = HHH1(3,3)
  348. XKTAT(4,1) = HHH1(3,1)
  349. XKTAT(4,2) = HHH1(3,2)
  350. XKTAT(1,4) = HHH1(1,3)
  351. XKTAT(2,4) = HHH1(2,3)
  352. 9999 CONTINUE
  353. C===============================================================
  354. C Fin de la routine
  355. C===============================================================
  356. RETURN
  357. END
  358.  
  359.  
  360.  
  361.  

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