Télécharger kpcoq6.eso

Retour à la liste

Numérotation des lignes :

kpcoq6
  1. C KPCOQ6 SOURCE CHAT 05/01/13 01:04:08 5004
  2. SUBROUTINE KPCOQ6(XX, P, XKP, IANT)
  3. C
  4. C Procedure de calcul de la matrice Kppour un element COQ4
  5. C Entrees : XX(3, 6) : REAL*8 : Coordonnees des noeuds
  6. C XP : REAL : Pression
  7. C IANT : INTEGER : 1 si calcul asymétrique, 0 sinon
  8. C Sortie : XKP(36, 36) : REAL*8 : Matrice Kp elementaire
  9. C
  10. C (D'apres "Design variations of nonlinear elastic structures
  11. C subjected to follower forces"
  12. C M.J. Poldneff, I.S. Rai, J.S. Arora)
  13. C
  14. IMPLICIT INTEGER(I-N)
  15. IMPLICIT REAL*8(A-H,O-Z)
  16. DIMENSION XX(3, 6), XKP(36, 36), SKRO(3, 3, 3),
  17. 1 XN(8, 30), XNB1(30), XNB2(30), XNB3(30), XNB4(30), XNB(30),
  18. 2 DNB1(30), DNB2(30), DN(2, 8, 30), DX(2, 3, 30),
  19. 3 XTIN(30), A(30), B(30), C(30), D(30), E(30), F(30),
  20. 4 XNB5(30), XNB6(30), XNB7(30), XDUM(36, 36)
  21. DATA XNB1/0.D0, 4.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  22. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  23. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  24. 2 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  25. 2 0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  26. DATA XNB2/0.D0, 0.D0, 4.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  27. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  28. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  29. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  30. 2 0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  31. DATA XNB3/0.D0, 0.D0, 0.D0, 4.D0, 0.D0, 0.D0, 0.D0,
  32. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  33. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  34. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  35. 2 0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  36. DATA XNB4/1.D0, -1.D0, -1.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  37. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  38. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  39. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  40. 2 0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  41. DATA XNB5/1.D0, -2.D0, -2.D0, 0.D0, 0.D0, 0.D0,
  42. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  43. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  44. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  45. 2 0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  46. DATA XNB6/-0.25, 0.5, 0.D0, 0.D0, 0.D0, 0.D0,
  47. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  48. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  49. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  50. 2 0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  51. DATA XNB7/-0.25, 0.D0, 0.5, 0.D0, 0.D0, 0.D0,
  52. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  53. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  54. 1 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  55. 2 0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  56. C
  57. C Initialisation du symbole epsilon
  58. C
  59. DO 10 I = 1, 3
  60. DO 10 J = 1, 3
  61. DO 10 K = 1, 3
  62. 10 SKRO(I, J, K) = 0.D0
  63. SKRO(1, 2, 3) = 1.D0
  64. SKRO(1, 3, 2) = -1.D0
  65. SKRO(2, 3, 1) = 1.D0
  66. SKRO(2, 1, 3) = -1.D0
  67. SKRO(3, 1, 2) = 1.D0
  68. SKRO(3, 2, 1) = -1.D0
  69. C
  70. C Calcul de la pression
  71. C
  72. * P = 0.
  73. * DO 20 I = 1, 3
  74. * 20 P = P + XP(I)
  75. * P = P/3.
  76. C
  77. C Fonctions de forme et derivees
  78. C
  79. C Les coefficients sont ranges comme suit :
  80. C indice : 1 2 3 4 5 6 7 8 9
  81. C terme : 1 T1 T2 T1*T2 T1^2 T2^2 T1*T2^2 T1^2*T2 T1^3
  82. C indice : 10 11 12 13 14 15
  83. C terme : T2^3 T1*T2^3 T1^2*T2^2 T1^3*T2^3 T1^4 T2^4
  84. C indice : 16 17 18 19 20 21
  85. C terme : T1*T2^4 T1^2*T2^3 T1^3*T2^2 T1^4*T2 T1^5 T2^5
  86. C indice : 22 23 24 25 26
  87. C terme : T1*T2^5 T1^2*T2^4 T1^3*T2^3 T1^4*T2^2 T1^5*T2
  88. C indice : 27 28 29 30
  89. C terme : T1^2*T2^5 T1^3*T2^4 T1^4*T2^3 T1^5*T2^2
  90. C
  91. CALL MULQP2(XNB4, XNB5, XNB)
  92. CALL DERQP2(XNB, 1, DNB1)
  93. CALL DERQP2(XNB, 2, DNB2)
  94. DO 31 I = 1, 30
  95. XN(1, I) = XNB(I)
  96. DN(1, 1, I) = DNB1(I)
  97. DN(2, 1, I) = DNB2(I)
  98. 31 CONTINUE
  99. CALL MULQP2(XNB1, XNB4, XNB)
  100. CALL DERQP2(XNB, 1, DNB1)
  101. CALL DERQP2(XNB, 2, DNB2)
  102. DO 32 I = 1, 30
  103. XN(2, I) = XNB(I)
  104. DN(1, 2, I) = DNB1(I)
  105. DN(2, 2, I) = DNB2(I)
  106. 32 CONTINUE
  107. CALL MULQP2(XNB1, XNB6, XNB)
  108. CALL DERQP2(XNB, 1, DNB1)
  109. CALL DERQP2(XNB, 2, DNB2)
  110. DO 33 I = 1, 30
  111. XN(3, I) = XNB(I)
  112. DN(1, 3, I) = DNB1(I)
  113. DN(2, 3, I) = DNB2(I)
  114. 33 CONTINUE
  115. CALL DERQP2(XNB3, 1, DNB1)
  116. CALL DERQP2(XNB3, 2, DNB2)
  117. DO 34 I = 1, 30
  118. XN(4, I) = XNB3(I)
  119. DN(1, 4, I) = DNB1(I)
  120. DN(2, 4, I) = DNB2(I)
  121. 34 CONTINUE
  122. CALL MULQP2(XNB2, XNB7, XNB)
  123. CALL DERQP2(XNB, 1, DNB1)
  124. CALL DERQP2(XNB, 2, DNB2)
  125. DO 35 I = 1, 30
  126. XN(5, I) = XNB(I)
  127. DN(1, 5, I) = DNB1(I)
  128. DN(2, 5, I) = DNB2(I)
  129. 35 CONTINUE
  130. CALL MULQP2(XNB2, XNB4, XNB)
  131. CALL DERQP2(XNB, 1, DNB1)
  132. CALL DERQP2(XNB, 2, DNB2)
  133. DO 36 I = 1, 30
  134. XN(6, I) = XNB(I)
  135. DN(1, 6, I) = DNB1(I)
  136. DN(2, 6, I) = DNB2(I)
  137. 36 CONTINUE
  138. C
  139. C Vecteurs tangents a la coque dans la configuration initiale
  140. C
  141. C Initialisation
  142. DO 40 I = 1, 2
  143. C Boucle sur les parametres
  144. DO 40 J = 1, 3
  145. C Boucle sur les composantes
  146. DO 40 K = 1, 30
  147. C Boucle sur les coefficients des polynomes
  148. DX(I, J, K) = 0.D0
  149. 40 CONTINUE
  150. C Calcul
  151. DO 50 I = 1, 2
  152. C Boucle sur les parametres
  153. DO 50 J = 1, 3
  154. C Boucle sur les composantes
  155. DO 50 K = 1, 30
  156. C Boucle sur les coefficients des polynomes
  157. DO 50 L = 1, 6
  158. C Boucle sur les noeuds
  159. DX(I, J, K) = DX(I, J, K) + XX(J, L)*DN(I, L, K)
  160. 50 CONTINUE
  161. C
  162. C Calcul des termes de la matrice Kp
  163. C
  164. C Initialisation
  165. DO 55 I = 1, 36
  166. DO 55 J = 1, 36
  167. XDUM(I,J) = 0.D0
  168. 55 XKP(I, J) = 0.D0
  169. C Calcul
  170. DO 60 II = 1, 3
  171. DO 60 IL = 1, 6
  172. DO 60 IS = 1, 3
  173. DO 60 IT = 1, 6
  174. XRES = 0.D0
  175. DO 70 J = 1, 3
  176. IFLAG = 0
  177. DO 71 K = 1, 30
  178. A(K) = XN(IL, K)
  179. D(K) = 0.D0
  180. 71 CONTINUE
  181. IF (SKRO(II, J, IS) .NE. 0.D0) THEN
  182. DO 81 K = 1, 30
  183. B(K) = DN(2, IT, K)
  184. C(K) = DX(1, J, K)
  185. 81 CONTINUE
  186. CALL MULQP2(B, C, E)
  187. DO 72 K = 1, 30
  188. 72 D(K) = SKRO(II, J, IS)*E(K)
  189. IFLAG = 1
  190. ENDIF
  191. IF (SKRO(II, IS, J) .NE. 0.D0) THEN
  192. DO 82 K = 1, 30
  193. B(K) = DN(1, IT, K)
  194. C(K) = DX(2, J, K)
  195. 82 CONTINUE
  196. CALL MULQP2(B, C, E)
  197. IF (IFLAG .EQ. 1) THEN
  198. DO 73 K = 1, 30
  199. 73 D(K) = D(K) + SKRO(II, IS, J)*E(K)
  200. ELSE
  201. DO 74 K = 1, 30
  202. 74 D(K) = SKRO(II, IS, J)*E(K)
  203. ENDIF
  204. IFLAG = 1
  205. ENDIF
  206. IF (IFLAG .NE. 0) THEN
  207. CALL MULQP2(A, D, XTIN)
  208. CALL INT6P2(XTIN, TING)
  209. XRES = XRES + TING
  210. ENDIF
  211. 70 CONTINUE
  212. XRES = XRES*P
  213. 60 XDUM(6*(IL-1) + II, 6*(IT-1) + IS) = XRES
  214. IF (IANT .EQ. 0) THEN
  215. DO 90 II = 1, 36
  216. DO 90 IJ = II, 36
  217. XKP(II, IJ) = (XDUM(II, IJ) + XDUM(IJ, II))*0.5D0
  218. 90 XKP(IJ, II) = XKP(II, IJ)
  219. ELSE
  220. DO 91 II = 1, 36
  221. DO 91 IJ = 1, 36
  222. 91 XKP(II, IJ) = XDUM(II, IJ)
  223. ENDIF
  224. RETURN
  225. END
  226.  
  227.  
  228.  

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