Télécharger kpcoq4.eso

Retour à la liste

Numérotation des lignes :

  1. C KPCOQ4 SOURCE PV 11/03/07 21:17:18 6885
  2. SUBROUTINE KPCOQ4(XX, XP, XKP, IANT)
  3. C
  4. C Procedure de calcul de la matrice Kppour un element COQ4
  5. C Entrees : XX(4, 3) : 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(24, 24) : 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, 4), XKP(24, 24), SKRO(3, 3, 3),
  17. 1 XN(4, 9), XNB1(9), XNB2(9), XNB3(9), XNB4(9), XNB(9),
  18. 2 DNB1(9), DNB2(9), DN(2, 4, 9), DX(2, 3, 9), XDUM(24, 24),
  19. 3 XTIN(9), A(9), B(9), C(9), D(9), E(9), F(9)
  20. DATA XNB1/0.5D0,0.D0,-0.5D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0/
  21. DATA XNB2/0.5D0,0.D0,0.5D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0/
  22. DATA XNB3/0.5D0,-0.5D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0/
  23. DATA XNB4/0.5D0,0.5,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,0.D0/
  24. C
  25. C Initialisation du symbole epsilon
  26. C
  27. DO 10 I = 1, 3
  28. DO 10 J = 1, 3
  29. DO 10 K = 1, 3
  30. 10 SKRO(I, J, K) = 0.D0
  31. SKRO(1, 2, 3) = 1.D0
  32. SKRO(1, 3, 2) = -1.D0
  33. SKRO(2, 3, 1) = 1.D0
  34. SKRO(2, 1, 3) = -1.D0
  35. SKRO(3, 1, 2) = 1.D0
  36. SKRO(3, 2, 1) = -1.D0
  37. C
  38. C Calcul de la pression
  39. C
  40. P = XP
  41. * DO 20 I = 1, 4
  42. * 20 P = P + XP(I)
  43. * P = P/4.
  44. * WRITE (*,*) 'Pression : ', P
  45. C
  46. C Fonctions de forme et derivees
  47. C
  48. C Les coefficients sont ranges comme suit :
  49. C indice : 1 2 3 4 5 6 7 8 9
  50. C terme : 1 T2 T1 T1*T2 T2^2 T1^2 T1*T2^2 T1^2*T2 T1^2*T2^2
  51. C
  52. CALL MULTP2(XNB1, XNB3, XNB)
  53. CALL DERIP2(XNB, 1, DNB1)
  54. CALL DERIP2(XNB, 2, DNB2)
  55. DO 31 I = 1, 9
  56. XN(1, I) = XNB(I)
  57. DN(1, 1, I) = DNB1(I)
  58. DN(2, 1, I) = DNB2(I)
  59. 31 CONTINUE
  60. CALL MULTP2(XNB2, XNB3, XNB)
  61. CALL DERIP2(XNB, 1, DNB1)
  62. CALL DERIP2(XNB, 2, DNB2)
  63. DO 32 I = 1, 9
  64. XN(2, I) = XNB(I)
  65. DN(1, 2, I) = DNB1(I)
  66. DN(2, 2, I) = DNB2(I)
  67. 32 CONTINUE
  68. CALL MULTP2(XNB2, XNB4, XNB)
  69. CALL DERIP2(XNB, 1, DNB1)
  70. CALL DERIP2(XNB, 2, DNB2)
  71. DO 33 I = 1, 9
  72. XN(3, I) = XNB(I)
  73. DN(1, 3, I) = DNB1(I)
  74. DN(2, 3, I) = DNB2(I)
  75. 33 CONTINUE
  76. CALL MULTP2(XNB1, XNB4, XNB)
  77. CALL DERIP2(XNB, 1, DNB1)
  78. CALL DERIP2(XNB, 2, DNB2)
  79. DO 34 I = 1, 9
  80. XN(4, I) = XNB(I)
  81. DN(1, 4, I) = DNB1(I)
  82. DN(2, 4, I) = DNB2(I)
  83. 34 CONTINUE
  84. C
  85. C Vecteurs tangents a la coque dans la configuration initiale
  86. C
  87. C Initialisation
  88. DO 40 I = 1, 2
  89. C Boucle sur les parametres
  90. DO 40 J = 1, 3
  91. C Boucle sur les composantes
  92. DO 40 K = 1, 9
  93. C Boucle sur les coefficients des polynomes
  94. DX(I, J, K) = 0.D0
  95. 40 CONTINUE
  96. C Calcul
  97. DO 50 I = 1, 2
  98. C Boucle sur les parametres
  99. DO 50 J = 1, 3
  100. C Boucle sur les composantes
  101. DO 50 K = 1, 9
  102. C Boucle sur les coefficients des polynomes
  103. DO 50 L = 1, 4
  104. C Boucle sur les noeuds
  105. DX(I, J, K) = DX(I, J, K) + XX(J, L)*DN(I, L, K)
  106. 50 CONTINUE
  107. C
  108. C
  109. C Calcul des termes de la matrice Kp
  110. C
  111. C Initialisation
  112. DO 55 I = 1, 24
  113. DO 55 J = 1, 24
  114. XDUM(I,J) = 0.D0
  115. 55 XKP(I, J) = 0. D0
  116. C Calcul
  117. DO 60 II = 1, 3
  118. DO 60 IL = 1, 4
  119. DO 60 IS = 1, 3
  120. DO 60 IT = 1, 4
  121. XRES = 0.D0
  122. DO 70 J = 1, 3
  123. IFLAG = 0
  124. DO 71 K = 1, 9
  125. A(K) = XN(IL, K)
  126. D(K) = 0.D0
  127. 71 CONTINUE
  128. IF (SKRO(II, J, IS) .NE. 0.D0) THEN
  129. DO 81 K = 1, 9
  130. B(K) = DN(2, IT, K)
  131. C(K) = DX(1, J, K)
  132. 81 CONTINUE
  133. CALL MULTP2(B, C, E)
  134. DO 72 K = 1, 9
  135. 72 D(K) = SKRO(II, J, IS)*E(K)
  136. IFLAG = 1
  137. ENDIF
  138. IF (SKRO(II, IS, J) .NE. 0.D0) THEN
  139. DO 82 K = 1, 9
  140. B(K) = DN(1, IT, K)
  141. C(K) = DX(2, J, K)
  142. 82 CONTINUE
  143. CALL MULTP2(B, C, E)
  144. IF (IFLAG .EQ. 1) THEN
  145. DO 73 K = 1, 9
  146. 73 D(K) = D(K) + SKRO(II, IS, J)*E(K)
  147. ELSE
  148. DO 74 K = 1, 9
  149. 74 D(K) = SKRO(II, IS, J)*E(K)
  150. ENDIF
  151. IFLAG = 1
  152. ENDIF
  153. IF (IFLAG .NE. 0) THEN
  154. CALL MULTP2(A, D, XTIN)
  155. CALL INTGP2(XTIN, TING)
  156. XRES = XRES + TING
  157. ENDIF
  158. 70 CONTINUE
  159. XRES = XRES*P
  160. 60 XDUM(6*(IL-1) + II, 6*(IT-1) + IS) = XRES
  161. IF (IANT .EQ. 0) THEN
  162. DO 90 II = 1, 24
  163. DO 90 IJ = II, 24
  164. XKP(II, IJ) = (XDUM(II, IJ) + XDUM(IJ, II))*0.5D0
  165. 90 XKP(IJ, II) = XKP(II, IJ)
  166. ELSE
  167. DO 91 II = 1, 24
  168. DO 91 IJ = 1, 24
  169. 91 XKP(II, IJ) = XDUM(II, IJ)
  170. ENDIF
  171. RETURN
  172. END
  173.  
  174.  
  175.  
  176.  

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