Télécharger pormao.eso

Retour à la liste

Numérotation des lignes :

  1. C PORMAO SOURCE CB215821 17/07/21 21:15:26 9513
  2. SUBROUTINE PORMAO(VELA,MATE,IFOU,IDIM,TXR,XLOC,
  3. . XGLOB,D1HOOK,ROTHOO,DDHOOK,LHOOK,COBMA,XMOB,KCAS,IRET)
  4. C-----------------------------------------------------------------------
  5. C
  6. C MATRICE DE HOOK DES ELEMENTS MASSIFS ORTHOTROPES OU ANISOTROPES
  7. C SPECIAL POUR MILIEU POREUX
  8. C
  9. C ENTREES
  10. C VELA() = materiau dans un tableau de travail
  11. C MATE = Nom du materiau
  12. C IFOU = num{ro d'harmonique de fourier: IFOUR de CCOPTIO
  13. C IDIM = DEFINIT SI ON EST EN 2D OU 3D
  14. C TXR = COS-DIRECTEURS DES AXES LOCAUX /REPERE GLOBAL
  15. C LHOOK = TAILLE DE LA MATRICE DE HOOKE
  16. C KCAS = 1 SI ON VEUT LA MATRICE POUR ELLE MEME
  17. C = 2 SI ON VEUT LA MATRICE POUR L'INVERSER ENSUITE
  18. C XLOC |
  19. C XGLOB |= TABLEAU DE TRAVAIL
  20. C D1HOOK|
  21. C
  22. C SORTIES
  23. C DDHOOK(LHOOK,LHOOK) = matrice de hooke
  24. C IRET = 1 si option existante 0 SINON
  25. C
  26. C INSPIRE DE DOHMAO
  27. C-----------------------------------------------------------------------
  28. C
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8(A-H,O-Z)
  31. PARAMETER(XZER=0.0D0)
  32. PARAMETER(UN=1.D0,DEUX=2.D0)
  33. CHARACTER*8 MATE
  34. C
  35. DIMENSION VELA(*),DDHOOK(LHOOK,*),TXR(IDIM,*)
  36. DIMENSION XLOC(3,3),D1HOOK(LHOOK,*)
  37. DIMENSION XGLOB(3,3),ROTHOO(LHOOK,*)
  38. DIMENSION COBMA(*),COBAUX(10)
  39. C
  40. IRET=1
  41. CALL ZERO(D1HOOK,LHOOK,LHOOK)
  42. CALL ZERO(XGLOB,3,3)
  43. CALL ZERO(XLOC,3,3)
  44. CALL ZERO(ROTHOO,LHOOK,LHOOK)
  45. CALL ZERO(DDHOOK,LHOOK,LHOOK)
  46. CALL ZERO(COBMA,LHOOK,1)
  47. CALL ZERO(COBAUX,LHOOK,1)
  48. C
  49. C 1 - MATERIAU ORTHOTROPE
  50. C =========================
  51. IF(MATE.EQ.'ORTHOTRO')THEN
  52. C =====
  53. C 1.1 - Definition de la matrice de HOOKE dans les axes d'ORTHOTROPIE
  54. C =====
  55. C= -> Contraintes planes et KCAS=1
  56. IF(IFOU.EQ.-2.AND.KCAS.EQ.1)THEN
  57. YG1=VELA(1)
  58. YG2=VELA(2)
  59. XNU12=VELA(3)
  60. G12=VELA(4)
  61. COBAUX(1)=VELA(7)
  62. COBAUX(2)=VELA(8)
  63. XMOB =VELA(9)
  64. XNU21=(YG2/YG1)*XNU12
  65. AUX=UN-XNU12*XNU21
  66. D1HOOK(1,1)=YG1/AUX
  67. D1HOOK(2,1)=XNU21*(YG1/AUX)
  68. D1HOOK(1,2)=D1HOOK(2,1)
  69. D1HOOK(2,2)=YG2/AUX
  70. D1HOOK(4,4)=G12
  71. C= -> Contraintes planes et KCAS=2
  72. ELSEIF(IFOU.EQ.-2.AND.KCAS.EQ.2)THEN
  73. YG1=VELA(1)
  74. YG2=VELA(2)
  75. XNU12=VELA(3)
  76. YG3=VELA(10)
  77. XNU23=VELA(11)
  78. XNU13=VELA(12)
  79. G12=VELA(4)
  80. COBAUX(1)=VELA(7)
  81. COBAUX(2)=VELA(8)
  82. XMOB =VELA(9)
  83. XNU21=(YG2/YG1)*XNU12
  84. XNU32=(YG3/YG2)*XNU23
  85. XNU31=(YG3/YG1)*XNU13
  86. AUX=(UN-XNU12*XNU21-XNU23*XNU32-XNU13*XNU31
  87. . -DEUX*XNU21*XNU32*XNU13)
  88. AUX1=AUX/YG1
  89. AUX2=AUX/YG2
  90. AUX3=AUX/YG3
  91. D1HOOK(1,1)=(UN-XNU23*XNU32)/AUX1
  92. D1HOOK(1,2)=(XNU21+XNU31*XNU23)/AUX1
  93. D1HOOK(2,1)=D1HOOK(1,2)
  94. D1HOOK(1,3)=(XNU31+XNU21*XNU32)/AUX1
  95. D1HOOK(3,1)=D1HOOK(1,3)
  96. D1HOOK(2,2)=(UN-XNU13*XNU31)/AUX2
  97. D1HOOK(2,3)=(XNU32+XNU12*XNU31)/AUX2
  98. D1HOOK(3,2)=D1HOOK(2,3)
  99. D1HOOK(3,3)=(UN-XNU12*XNU21)/AUX3
  100. D1HOOK(4,4)=G12
  101. C= -> Deformations planes, Axisymetrie
  102. ELSEIF(IFOU.EQ.-1.OR.IFOU.EQ.0) THEN
  103. YG1=VELA(1)
  104. YG2=VELA(2)
  105. YG3=VELA(3)
  106. XNU12=VELA(4)
  107. XNU23=VELA(5)
  108. XNU13=VELA(6)
  109. G12=VELA(7)
  110. COBAUX(1)=VELA(10)
  111. COBAUX(2)=VELA(11)
  112. COBAUX(3)=VELA(12)
  113. XMOB =VELA(13)
  114. XNU21=(YG2/YG1)*XNU12
  115. XNU32=(YG3/YG2)*XNU23
  116. XNU31=(YG3/YG1)*XNU13
  117. AUX=(UN-XNU12*XNU21-XNU23*XNU32-XNU13*XNU31
  118. . -DEUX*XNU21*XNU32*XNU13)
  119. AUX1=AUX/YG1
  120. AUX2=AUX/YG2
  121. AUX3=AUX/YG3
  122. D1HOOK(1,1)=(UN-XNU23*XNU32)/AUX1
  123. D1HOOK(1,2)=(XNU21+XNU31*XNU23)/AUX1
  124. D1HOOK(2,1)=D1HOOK(1,2)
  125. D1HOOK(1,3)=(XNU31+XNU21*XNU32)/AUX1
  126. D1HOOK(3,1)=D1HOOK(1,3)
  127. D1HOOK(2,2)=(UN-XNU13*XNU31)/AUX2
  128. D1HOOK(2,3)=(XNU32+XNU12*XNU31)/AUX2
  129. D1HOOK(3,2)=D1HOOK(2,3)
  130. D1HOOK(3,3)=(UN-XNU12*XNU21)/AUX3
  131. D1HOOK(4,4)=G12
  132. C= -> Serie de Fourier et 3D
  133. ELSEIF(IFOU.EQ.1.OR.IFOU.EQ.2)THEN
  134. YG1=VELA(1)
  135. YG2=VELA(2)
  136. YG3=VELA(3)
  137. XNU12=VELA(4)
  138. XNU23=VELA(5)
  139. XNU13=VELA(6)
  140. G12=VELA(7)
  141. G23=VELA(8)
  142. G13=VELA(9)
  143. IF(IFOU.EQ.1) THEN
  144. COBAUX(1)=VELA(12)
  145. COBAUX(2)=VELA(13)
  146. COBAUX(3)=VELA(14)
  147. XMOB =VELA(15)
  148. ELSEIF (IFOU.EQ.2) THEN
  149. COBAUX(1)=VELA(16)
  150. COBAUX(2)=VELA(17)
  151. COBAUX(3)=VELA(18)
  152. XMOB =VELA(19)
  153. ENDIF
  154. XNU21=(YG2/YG1)*XNU12
  155. XNU32=(YG3/YG2)*XNU23
  156. XNU31=(YG3/YG1)*XNU13
  157. AUX=(UN-XNU12*XNU21-XNU23*XNU32-XNU13*XNU31
  158. . -DEUX*XNU21*XNU32*XNU13)
  159. AUX1=AUX/YG1
  160. AUX2=AUX/YG2
  161. AUX3=AUX/YG3
  162. D1HOOK(1,1)=(UN-XNU23*XNU32)/AUX1
  163. D1HOOK(1,2)=(XNU21+XNU31*XNU23)/AUX1
  164. D1HOOK(2,1)=D1HOOK(1,2)
  165. D1HOOK(1,3)=(XNU31+XNU21*XNU32)/AUX1
  166. D1HOOK(3,1)=D1HOOK(1,3)
  167. D1HOOK(2,2)=(UN-XNU13*XNU31)/AUX2
  168. D1HOOK(2,3)=(XNU32+XNU12*XNU31)/AUX2
  169. D1HOOK(3,2)=D1HOOK(2,3)
  170. D1HOOK(3,3)=(UN-XNU12*XNU21)/AUX3
  171. D1HOOK(4,4)=G12
  172. D1HOOK(5,5)=G13
  173. D1HOOK(6,6)=G23
  174. ENDIF
  175. C =====
  176. C 1.2 - Definition de la matrice de passage des axes d'ORTHOTROPIE
  177. C aux axes LOCAUX au point considere (dimensions 2 et 3)
  178. C =====
  179. cbp IF (IDIM.EQ.2) THEN
  180. IF (IDIM.EQ.2.AND.IFOU.NE.1) THEN
  181. IF(IFOU.EQ.-2)THEN
  182. XLOC(1,1)=VELA(5)
  183. XLOC(2,1)=VELA(6)
  184. ELSEIF(IFOU.EQ.-1.OR.IFOU.EQ.0)THEN
  185. XLOC(1,1)=VELA(8)
  186. XLOC(2,1)=VELA(9)
  187. c ELSEIF(IFOU.EQ.1)THEN
  188. c XLOC(1,1)=VELA(10)
  189. c XLOC(2,1)=VELA(11)
  190. ENDIF
  191. XLOC(1,2)=-XLOC(2,1)
  192. XLOC(2,2)=XLOC(1,1)
  193. cbp ELSEIF(IDIM.EQ.3)THEN
  194. ELSE
  195. XLOC(1,1)=VELA(10)
  196. XLOC(2,1)=VELA(11)
  197. XLOC(3,1)=VELA(12)
  198. XLOC(1,2)=VELA(13)
  199. XLOC(2,2)=VELA(14)
  200. XLOC(3,2)=VELA(15)
  201. CALL CROSS2(XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR)
  202. ENDIF
  203.  
  204. C 2 - MATERIAU ANISOTROPE
  205. C =========================
  206. ELSEIF(MATE.EQ.'ANISOTRO')THEN
  207. C =====
  208. C 2.1 - Definition de la matrice de HOOKE dans les axes d'ANISOTROPIE
  209. C =====
  210. C= -> Contraintes planes et KCAS=1
  211. IF(IFOU.EQ.-2.AND.KCAS.EQ.1)THEN
  212. D11=VELA(1)
  213. D21=VELA(2)
  214. D22=VELA(3)
  215. D31=VELA(13)
  216. D32=VELA(14)
  217. D33=VELA(15)
  218. IF (D33.EQ.0.D0) D33=D11*1.E0-6
  219. D41=VELA(4)
  220. D42=VELA(5)
  221. D43=VELA(16)
  222. D44=VELA(6)
  223. D1HOOK(1,1)=D11 - ((D31**2)/D33)
  224. D1HOOK(2,1)=D21 - ((D31*D32)/D33)
  225. D1HOOK(1,2)=D1HOOK(2,1)
  226. D1HOOK(2,2)=D22 - ((D32**2)/D33)
  227. D1HOOK(4,1)=D41 - ((D31*D43)/D33)
  228. D1HOOK(1,4)=D1HOOK(4,1)
  229. D1HOOK(4,2)=D42 - ((D32*D43)/D33)
  230. D1HOOK(2,4)=D1HOOK(4,2)
  231. D1HOOK(4,4)=D44 - ((D43**2)/D33)
  232. COBAUX(1)=VELA( 9)
  233. COBAUX(2)=VELA(10)
  234. COBAUX(3)=0.D0
  235. COBAUX(4)=VELA(11)
  236. XMOB =VELA(12)
  237. C= -> Contraintes planes et KCAS=2
  238. ELSEIF(IFOU.EQ.-2.AND.KCAS.EQ.2)THEN
  239. D1HOOK(1,1)=VELA(1)
  240. D1HOOK(2,1)=VELA(2)
  241. D1HOOK(1,2)=D1HOOK(2,1)
  242. D1HOOK(2,2)=VELA(3)
  243. D1HOOK(3,1)=VELA(13)
  244. D1HOOK(1,3)=D1HOOK(3,1)
  245. D1HOOK(3,2)=VELA(14)
  246. D1HOOK(2,3)=D1HOOK(3,2)
  247. D1HOOK(3,3)=VELA(15)
  248. D1HOOK(4,1)=VELA(4)
  249. D1HOOK(1,4)=D1HOOK(4,1)
  250. D1HOOK(4,2)=VELA(5)
  251. D1HOOK(2,4)=D1HOOK(4,2)
  252. D1HOOK(4,3)=VELA(16)
  253. D1HOOK(3,4)=D1HOOK(4,3)
  254. D1HOOK(4,4)=VELA(6)
  255. COBAUX(1)=VELA( 9)
  256. COBAUX(2)=VELA(10)
  257. COBAUX(3)=0.D0
  258. COBAUX(4)=VELA(11)
  259. XMOB =VELA(12)
  260. C= -> Deformations planes et Axisymetrie
  261. ELSEIF(IFOU.EQ.-1.OR.IFOU.EQ.0) THEN
  262. D1HOOK(1,1)=VELA(1)
  263. D1HOOK(2,1)=VELA(2)
  264. D1HOOK(1,2)=D1HOOK(2,1)
  265. D1HOOK(2,2)=VELA(3)
  266. D1HOOK(3,1)=VELA(4)
  267. D1HOOK(1,3)=D1HOOK(3,1)
  268. D1HOOK(3,2)=VELA(5)
  269. D1HOOK(2,3)=D1HOOK(3,2)
  270. D1HOOK(3,3)=VELA(6)
  271. D1HOOK(4,1)=VELA(7)
  272. D1HOOK(1,4)=D1HOOK(4,1)
  273. D1HOOK(4,2)=VELA(8)
  274. D1HOOK(2,4)=D1HOOK(4,2)
  275. D1HOOK(4,3)=VELA(9)
  276. D1HOOK(3,4)=D1HOOK(4,3)
  277. D1HOOK(4,4)=VELA(10)
  278. COBAUX(1)=VELA(13)
  279. COBAUX(2)=VELA(14)
  280. COBAUX(3)=VELA(16)
  281. COBAUX(4)=VELA(15)
  282. XMOB =VELA(17)
  283. C= -> Serie de Fourier et 3D
  284. ELSEIF(IFOU.EQ.1.OR.IFOU.EQ.2)THEN
  285. D1HOOK(1,1)=VELA(1)
  286. D1HOOK(2,1)=VELA(2)
  287. D1HOOK(1,2)=D1HOOK(2,1)
  288. D1HOOK(2,2)=VELA(3)
  289. D1HOOK(3,1)=VELA(4)
  290. D1HOOK(1,3)=D1HOOK(3,1)
  291. D1HOOK(3,2)=VELA(5)
  292. D1HOOK(2,3)=D1HOOK(3,2)
  293. D1HOOK(3,3)=VELA(6)
  294. D1HOOK(4,1)=VELA(7)
  295. D1HOOK(1,4)=D1HOOK(4,1)
  296. D1HOOK(4,2)=VELA(8)
  297. D1HOOK(2,4)=D1HOOK(4,2)
  298. D1HOOK(4,3)=VELA(9)
  299. D1HOOK(3,4)=D1HOOK(4,3)
  300. D1HOOK(4,4)=VELA(10)
  301. IF(IFOU.EQ.1)THEN
  302. D1HOOK(5,5)=VELA(11)
  303. D1HOOK(6,5)=VELA(12)
  304. D1HOOK(5,6)=D1HOOK(6,5)
  305. D1HOOK(6,6)=VELA(13)
  306. COBAUX(1)=VELA(16)
  307. COBAUX(2)=VELA(17)
  308. COBAUX(3)=VELA(19)
  309. COBAUX(4)=VELA(18)
  310. XMOB =VELA(20)
  311. ELSE
  312. D1HOOK(5,1)=VELA(11)
  313. D1HOOK(1,5)=D1HOOK(5,1)
  314. D1HOOK(5,2)=VELA(12)
  315. D1HOOK(2,5)=D1HOOK(5,2)
  316. D1HOOK(5,3)=VELA(13)
  317. D1HOOK(3,5)=D1HOOK(5,3)
  318. D1HOOK(5,4)=VELA(14)
  319. D1HOOK(4,5)=D1HOOK(5,4)
  320. D1HOOK(5,5)=VELA(15)
  321. D1HOOK(6,1)=VELA(16)
  322. D1HOOK(1,6)=D1HOOK(6,1)
  323. D1HOOK(6,2)=VELA(17)
  324. D1HOOK(2,6)=D1HOOK(6,2)
  325. D1HOOK(6,3)=VELA(18)
  326. D1HOOK(3,6)=D1HOOK(6,3)
  327. D1HOOK(6,4)=VELA(19)
  328. D1HOOK(4,6)=D1HOOK(6,4)
  329. D1HOOK(6,5)=VELA(20)
  330. D1HOOK(5,6)=D1HOOK(6,5)
  331. D1HOOK(6,6)=VELA(21)
  332. COBAUX(1)=VELA(28)
  333. COBAUX(2)=VELA(29)
  334. COBAUX(3)=VELA(30)
  335. COBAUX(4)=VELA(31)
  336. COBAUX(5)=VELA(32)
  337. COBAUX(6)=VELA(33)
  338. XMOB =VELA(34)
  339. ENDIF
  340. ENDIF
  341. C =====
  342. C 2.2 - Definition de la matrice de passage des axes d'ANSIOTROPIE
  343. C aux axes LOCAUX au point considere (dimensions 2 et 3)
  344. C =====
  345. IF(IDIM.EQ.2)THEN
  346. IF(IFOU.EQ.-2)THEN
  347. XLOC(1,1)=VELA(7)
  348. XLOC(2,1)=VELA(8)
  349. ELSEIF(IFOU.EQ.-1.OR.IFOU.EQ.0)THEN
  350. XLOC(1,1)=VELA(11)
  351. XLOC(2,1)=VELA(12)
  352. ELSEIF(IFOU.EQ.1)THEN
  353. XLOC(1,1)=VELA(14)
  354. XLOC(2,1)=VELA(15)
  355. ENDIF
  356. XLOC(1,2)=-XLOC(2,1)
  357. XLOC(2,2)=XLOC(1,1)
  358. ELSEIF(IDIM.EQ.3)THEN
  359. XLOC(1,1)=VELA(22)
  360. XLOC(2,1)=VELA(23)
  361. XLOC(3,1)=VELA(24)
  362. XLOC(1,2)=VELA(25)
  363. XLOC(2,2)=VELA(26)
  364. XLOC(3,2)=VELA(27)
  365. CALL CROSS2(XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR)
  366. ENDIF
  367.  
  368. C 3 - MATERIAU UNIDIRECTIONNEL
  369. C ==============================
  370. ELSEIF(MATE.EQ.'UNIDIREC')THEN
  371. C =====
  372. C 3.1 - Definition de la matrice de HOOKE dans les axes d'ANISOTROPIE
  373. C (par rapport aux axes d'armatures)
  374. C =====
  375. D1HOOK(1,1)=VELA(1)
  376. COBAUX(1)=VELA(4)
  377. XMOB =VELA(5)
  378. C =====
  379. C 3.2 - Definition de la matrice de passage des axes d'ANISOTROPIE
  380. C aux axes LOCAUX au point considere (dimensions 2 et 3)
  381. C =====
  382. IF(IDIM.EQ.2)THEN
  383. XLOC(1,1)=VELA(2)
  384. XLOC(2,1)=VELA(3)
  385. XLOC(1,2)=-XLOC(2,1)
  386. XLOC(2,2)=XLOC(1,1)
  387. ELSEIF(IDIM.EQ.3)THEN
  388. XLOC(1,1)=VELA(2)
  389. XLOC(2,1)=VELA(3)
  390. XLOC(3,1)=VELA(4)
  391. XLOC(1,2)=VELA(5)
  392. XLOC(2,2)=VELA(6)
  393. XLOC(3,2)=VELA(7)
  394. CALL CROSS2(XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR)
  395. ENDIF
  396.  
  397. C 4 - MATERIAUX NON PREVUS
  398. C ==========================
  399. ELSE
  400. IRET=0
  401. RETURN
  402. ENDIF
  403. C
  404. C 5 - DEFINITION DE LA MATRICE DE PASSAGE DES AXES
  405. C D'ORTHO/ANISOTROPIE AUX AXES DU REPERE GLOBAL
  406. C ===================================================
  407. IF (IDIM.EQ.1) RETURN
  408. C
  409. IDIM2=IDIM
  410. IF(IFOU.EQ.1) IDIM2=3
  411. DO j=1,IDIM
  412. DO k=1,IDIM2
  413. cc=XZER
  414. DO i=1,IDIM
  415. cc=cc+TXR(j,i)*XLOC(i,k)
  416. ENDDO
  417. XGLOB(k,j)=cc
  418. ENDDO
  419. ENDDO
  420. cbp en 2D Fourier, vrai TXR = [TXR(2x2) [0] ; [0] 1]
  421. IF (IFOU.EQ.1) THEN
  422. XGLOB(1,3)=XLOC(3,1)
  423. XGLOB(2,3)=XLOC(3,2)
  424. XGLOB(3,3)=XLOC(3,3)
  425. ENDIF
  426.  
  427. C MATRICE DE TRANSFORMATION
  428. cbp IF (IDIM.EQ.2) THEN
  429. IF (IDIM.EQ.2.AND.IFOU.NE.1) THEN
  430. ROTHOO(1,1)=XGLOB(1,1)*XGLOB(1,1)
  431. ROTHOO(1,2)=XGLOB(1,2)*XGLOB(1,2)
  432. ROTHOO(1,4)=XGLOB(1,1)*XGLOB(1,2)
  433. ROTHOO(2,1)=XGLOB(2,1)*XGLOB(2,1)
  434. ROTHOO(2,2)=XGLOB(2,2)*XGLOB(2,2)
  435. ROTHOO(2,4)=XGLOB(2,1)*XGLOB(2,2)
  436. ROTHOO(3,3)=UN
  437. ROTHOO(4,1)=DEUX*XGLOB(1,1)*XGLOB(2,1)
  438. ROTHOO(4,2)=DEUX*XGLOB(1,2)*XGLOB(2,2)
  439. ROTHOO(4,4)=XGLOB(1,2)*XGLOB(2,1)+XGLOB(1,1)*XGLOB(2,2)
  440. c IF(IFOU.EQ.1)THEN
  441. c ROTHOO(5,5)=XGLOB(1,1)
  442. c ROTHOO(5,6)=XGLOB(1,2)
  443. c ROTHOO(6,5)=XGLOB(2,1)
  444. c ROTHOO(6,6)=XGLOB(2,2)
  445. c ENDIF
  446. cbp ELSEIF(IDIM.EQ.3)THEN
  447. ELSE
  448. DO 100 IC=1,3
  449. DO 100 IL=1,3
  450. ROTHOO(IL,IC)=XGLOB(IL,IC)*XGLOB(IL,IC)
  451. 100 CONTINUE
  452. DO 110 IL=1,3
  453. ROTHOO(IL,4)=XGLOB(IL,1)*XGLOB(IL,2)
  454. ROTHOO(IL,5)=XGLOB(IL,2)*XGLOB(IL,3)
  455. ROTHOO(IL,6)=XGLOB(IL,1)*XGLOB(IL,3)
  456. 110 CONTINUE
  457. DO 120 IC=1,3
  458. ROTHOO(4,IC)=DEUX*XGLOB(1,IC)*XGLOB(2,IC)
  459. ROTHOO(5,IC)=DEUX*XGLOB(2,IC)*XGLOB(3,IC)
  460. ROTHOO(6,IC)=DEUX*XGLOB(1,IC)*XGLOB(3,IC)
  461. 120 CONTINUE
  462. DO 130 IL=4,6
  463. IL1=IL-3
  464. IL2=IL1+1
  465. IF(IL2.GT.3)IL2=IL2-3
  466. DO 130 IC=4,6
  467. IC1=IC-3
  468. IC2=IC1+1
  469. IF(IC2.GT.3)IC2=IC2-3
  470. ROTHOO(IL,IC)=XGLOB(IL1,IC1)*XGLOB(IL2,IC2)+
  471. . XGLOB(IL1,IC2)*XGLOB(IL2,IC1)
  472. 130 CONTINUE
  473. DO 135 IC=1,6
  474. AA=ROTHOO(6,IC)
  475. ROTHOO(6,IC)=ROTHOO(5,IC)
  476. ROTHOO(5,IC)=AA
  477. 135 CONTINUE
  478. DO 136 IL=1,6
  479. AA=ROTHOO(IL,6)
  480. ROTHOO(IL,6)=ROTHOO(IL,5)
  481. ROTHOO(IL,5)=AA
  482. 136 CONTINUE
  483. ENDIF
  484.  
  485.  
  486. C 6 - CALCUL DE LA MATRICE DE HOOKE DANS LE REPERE GLOBAL
  487. C ET DE COBAUX
  488. C =========================================================
  489. C
  490. CALL PRODT(DDHOOK,D1HOOK,ROTHOO,LHOOK,LHOOK)
  491. *
  492. DO 140 IL=1,LHOOK
  493. DO 140 IC=1,LHOOK
  494. COBMA(IL)=COBMA(IL)+ROTHOO(IC,IL)*COBAUX(IC)
  495. 140 CONTINUE
  496.  
  497.  
  498. RETURN
  499. END
  500.  
  501.  
  502.  
  503.  
  504.  
  505.  

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