Télécharger kpcoq3.eso

Retour à la liste

Numérotation des lignes :

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

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