Télécharger la plaquette Cast3M


fr en

Télécharger kpcoq8.eso

Retour à la liste

Numérotation des lignes : 

kpcoq8

  1. C KPCOQ8    SOURCE    CB215821  26/08/24    21:17:04     12622          
  2.       SUBROUTINE KPCOQ8(XX, P, XKP, IANT)
  3. C
  4. C     Procedure de calcul de la matrice Kppour un element COQ4
  5. C     Entrees : XX(3, 8) : REAL*8 : Coordonnees des noeuds
  6. C               XP(4) : REAL*8 : Pression aux points de Gauss
  7. C               IANT : INTEGER : 1 si calcul asymétrique, 0 sinon
  8. C     Sortie :  XKP(48, 48) : 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 XP(4), XX(3, 8), XKP(48, 48), 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), XNB8(30), XNB9(30), XNB10(30),
  21.      5    XDUM(48, 48)
  22.       DATA XNB1/0.5D0, -0.5D0, 0.D0, 0.D0, 0.D0,
  23.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  24.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  25.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  26.      2       0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  27.       DATA XNB2/0.5D0, 0.5D0, 0.D0, 0.D0, 0.D0,
  28.      1       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, 0.D0,
  30.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  31.      2       0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  32.       DATA XNB3/0.5D0, 0.D0, -0.5D0, 0.D0, 0.D0,
  33.      1       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, 0.D0,
  35.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  36.      2       0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  37.       DATA XNB4/0.5D0, 0.D0, 0.5D0, 0.D0, 0.D0,
  38.      1       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, 0.D0,
  40.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  41.      2       0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  42.       DATA XNB5/1.D0, 0.D0, 0.D0, 0.D0, -1.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.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  46.      2       0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  47.       DATA XNB6/1.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  48.      1       -1.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.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  51.      2       0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  52.       DATA XNB7/-1.D0, -1.D0, -1.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.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  56.      2       0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  57.       DATA XNB8/-1, 1.D0, 1.D0, 0.D0, 0.D0, 0.D0,
  58.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  59.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  60.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  61.      2       0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  62.       DATA XNB9/-1.D0, 1.D0, -1.D0, 0.D0, 0.D0,
  63.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  64.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  65.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  66.      2       0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  67.       DATA XNB10/-1.D0, -1.D0, 1.D0, 0.D0, 0.D0,
  68.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  69.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  70.      1       0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0, 0.D0,
  71.      2       0.D0, 0.D0, 0.D0, 0.D0, 0.D0/
  72. C
  73. C     Initialisation du symbole epsilon
  74. C
  75.       DO 93 I = 1, 3
  76.          DO 92 J = 1, 3
  77.             DO 10 K = 1, 3
  78.                SKRO(I, J, K) = 0.D0
  79.    10       CONTINUE
  80.    92    CONTINUE
  81.    93 CONTINUE
  82.       SKRO(1, 2, 3) = 1.D0
  83.       SKRO(1, 3, 2) = -1.D0
  84.       SKRO(2, 3, 1) = 1.D0
  85.       SKRO(2, 1, 3) = -1.D0
  86.       SKRO(3, 1, 2) = 1.D0
  87.       SKRO(3, 2, 1) = -1.D0
  88. C
  89. C     Calcul de la pression
  90. C
  91. *      P = 0.
  92. *      DO 20 I = 1, 9
  93. *   20    P = P + XP(I)
  94. *      P = P/9.
  95. C
  96. C     Fonctions de forme et derivees
  97. C
  98. C     Les coefficients sont ranges comme suit :
  99. C               indice : 1 2  3    4    5    6      7       8    9
  100. C               terme :  1 T1 T2 T1*T2 T1^2 T2^2 T1*T2^2 T1^2*T2 T1^3
  101. C               indice : 10   11      12        13        14   15
  102. C               terme :  T2^3 T1*T2^3 T1^2*T2^2 T1^3*T2^3 T1^4 T2^4
  103. C               indice : 16      17        18        19      20   21
  104. C               terme :  T1*T2^4 T1^2*T2^3 T1^3*T2^2 T1^4*T2 T1^5 T2^5
  105. C               indice : 22      23        24        25        26
  106. C               terme :  T1*T2^5 T1^2*T2^4 T1^3*T2^3 T1^4*T2^2 T1^5*T2
  107. C               indice : 27        28        29        30
  108. C               terme :  T1^2*T2^5 T1^3*T2^4 T1^4*T2^3 T1^5*T2^2
  109. C
  110.       CALL MULQP2(XNB1, XNB3, A)
  111.       CALL MULQP2(A, XNB7, XNB)
  112.       CALL DERQP2(XNB, 1, DNB1)
  113.       CALL DERQP2(XNB, 2, DNB2)
  114.       DO 31 I = 1, 30
  115.          XN(1, I) = XNB(I)
  116.          DN(1, 1, I) = DNB1(I)
  117.          DN(2, 1, I) = DNB2(I)
  118.    31 CONTINUE
  119.       CALL MULQP2(XNB3, XNB5, XNB)
  120.       CALL DERQP2(XNB, 1, DNB1)
  121.       CALL DERQP2(XNB, 2, DNB2)
  122.       DO 32 I = 1, 30
  123.          XN(2, I) = XNB(I)
  124.          DN(1, 2, I) = DNB1(I)
  125.          DN(2, 2, I) = DNB2(I)
  126.    32 CONTINUE
  127.       CALL MULQP2(XNB2, XNB3, A)
  128.       CALL MULQP2(A, XNB9, XNB)
  129.       CALL DERQP2(XNB, 1, DNB1)
  130.       CALL DERQP2(XNB, 2, DNB2)
  131.       DO 33 I = 1, 30
  132.          XN(3, I) = XNB(I)
  133.          DN(1, 3, I) = DNB1(I)
  134.          DN(2, 3, I) = DNB2(I)
  135.    33 CONTINUE
  136.       CALL MULQP2(XNB2, XNB6, XNB)
  137.       CALL DERQP2(XNB, 1, DNB1)
  138.       CALL DERQP2(XNB, 2, DNB2)
  139.       DO 34 I = 1, 30
  140.          XN(4, I) = XNB(I)
  141.          DN(1, 4, I) = DNB1(I)
  142.          DN(2, 4, I) = DNB2(I)
  143.    34 CONTINUE
  144.       CALL MULQP2(XNB2, XNB4, A)
  145.       CALL MULQP2(A, XNB8, XNB)
  146.       CALL DERQP2(XNB, 1, DNB1)
  147.       CALL DERQP2(XNB, 2, DNB2)
  148.       DO 35 I = 1, 30
  149.          XN(5, I) = XNB(I)
  150.          DN(1, 5, I) = DNB1(I)
  151.          DN(2, 5, I) = DNB2(I)
  152.    35 CONTINUE
  153.       CALL MULQP2(XNB4, XNB5, XNB)
  154.       CALL DERQP2(XNB, 1, DNB1)
  155.       CALL DERQP2(XNB, 2, DNB2)
  156.       DO 36 I = 1, 30
  157.          XN(6, I) = XNB(I)
  158.          DN(1, 6, I) = DNB1(I)
  159.          DN(2, 6, I) = DNB2(I)
  160.    36 CONTINUE
  161.       CALL MULQP2(XNB1, XNB4, A)
  162.       CALL MULQP2(A, XNB10, XNB)
  163.       CALL DERQP2(XNB, 1, DNB1)
  164.       CALL DERQP2(XNB, 2, DNB2)
  165.       DO 37 I = 1, 30
  166.          XN(7, I) = XNB(I)
  167.          DN(1, 7, I) = DNB1(I)
  168.          DN(2, 7, I) = DNB2(I)
  169.    37 CONTINUE
  170.       CALL MULQP2(XNB1, XNB6, XNB)
  171.       CALL DERQP2(XNB, 1, DNB1)
  172.       CALL DERQP2(XNB, 2, DNB2)
  173.       DO 38 I = 1, 30
  174.          XN(8, I) = XNB(I)
  175.          DN(1, 8, I) = DNB1(I)
  176.          DN(2, 8, I) = DNB2(I)
  177.    38 CONTINUE
  178. C
  179. C     Vecteurs tangents a la coque dans la configuration initiale
  180. C
  181. C     Initialisation
  182.       DO 95 I = 1, 2
  183. C          Boucle sur les parametres
  184.          DO 94 J = 1, 3
  185. C             Boucle sur les composantes
  186.             DO 40 K = 1, 30
  187. C                Boucle sur les coefficients des polynomes
  188.                DX(I, J, K) = 0.D0
  189.    40 CONTINUE
  190.    94    CONTINUE
  191.    95 CONTINUE
  192. C     Calcul
  193.       DO 98 I = 1, 2
  194. C          Boucle sur les parametres
  195.          DO 97 J = 1, 3
  196. C             Boucle sur les composantes
  197.             DO 96 K = 1, 30
  198. C                Boucle sur les coefficients des polynomes
  199.                DO 50 L = 1, 8
  200. C                   Boucle sur les noeuds
  201.             DX(I, J, K) = DX(I, J, K) + XX(J, L)*DN(I, L, K)
  202.    50 CONTINUE
  203.    96       CONTINUE
  204.    97    CONTINUE
  205.    98 CONTINUE
  206. C
  207. C     Calcul des termes de la matrice Kp
  208. C
  209. C     Initialisation
  210.       DO 99 I = 1, 48
  211.          DO 55 J = 1, 48
  212.             XDUM(I,J) = 0.D0
  213.             XKP(I, J) = 0.D0
  214.    55    CONTINUE
  215.    99 CONTINUE
  216. C     Calcul
  217.       DO 102 II = 1, 3
  218.          DO 101 IL = 1, 8
  219.             DO 100 IS = 1, 3
  220.                DO 60 IT = 1, 8
  221.                   XRES = 0.D0
  222.                   DO 70 J = 1, 3
  223.                      IFLAG = 0
  224.                      DO 71 K = 1, 30
  225.                         A(K) = XN(IL, K)
  226.                         D(K) = 0.D0
  227.    71                CONTINUE
  228.                      IF (SKRO(II, J, IS) .NE. 0.D0) THEN
  229.                         DO 81 K = 1, 30
  230.                            B(K) = DN(2, IT, K)
  231.                            C(K) = DX(1, J, K)
  232.    81                   CONTINUE
  233.                         CALL MULQP2(B, C, E)
  234.                         DO 72 K = 1, 30
  235.                            D(K) = SKRO(II, J, IS)*E(K)
  236.    72                   CONTINUE
  237.                         IFLAG = 1
  238.                      ENDIF
  239.                      IF (SKRO(II, IS, J) .NE. 0.D0) THEN
  240.                         DO 82 K = 1, 30
  241.                            B(K) = DN(1, IT, K)
  242.                            C(K) = DX(2, J, K)
  243.    82                   CONTINUE
  244.                         CALL MULQP2(B, C, E)
  245.                         IF (IFLAG .EQ. 1) THEN
  246.                            DO 73 K = 1, 30
  247.                               D(K) = D(K) + SKRO(II, IS, J)*E(K)
  248.    73                      CONTINUE
  249.                         ELSE
  250.                            DO 74 K = 1, 30
  251.                               D(K) = SKRO(II, IS, J)*E(K)
  252.    74                      CONTINUE
  253.                         ENDIF
  254.                         IFLAG = 1
  255.                      ENDIF
  256.                      IF (IFLAG .NE. 0) THEN
  257.                         CALL MULQP2(A, D, XTIN)
  258.                         CALL INTQP2(XTIN, TING)
  259.                         XRES = XRES + TING
  260.                      ENDIF
  261.    70             CONTINUE
  262.                   XRES = XRES*P
  263.                   XDUM(6*(IL-1) + II, 6*(IT-1) + IS) = XRES
  264.    60          CONTINUE
  265.   100       CONTINUE
  266.   101    CONTINUE
  267.   102 CONTINUE
  268.       IF (IANT .EQ. 0) THEN
  269.          DO 103 II = 1, 48
  270.             DO 90 IJ = II, 48
  271.                XKP(II, IJ) = (XDUM(II, IJ) + XDUM(IJ, II))*0.5D0
  272.                XKP(IJ, II) = XKP(II, IJ)
  273.    90       CONTINUE
  274.   103    CONTINUE
  275.       ELSE
  276.          DO 104 II = 1, 48
  277.             DO 91 IJ = 1, 48
  278.                XKP(II, IJ) = XDUM(II, IJ)
  279.    91       CONTINUE
  280.   104    CONTINUE
  281.       ENDIF
  282.       RETURN
  283.       END
  284.  
  285.  
  286.  
  287.  
  288.  

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