Télécharger la plaquette Cast3M


fr en

Télécharger coq8ks.eso

Retour à la liste

Numérotation des lignes : 

coq8ks

  1. C COQ8KS    SOURCE    CB215821  26/08/24    21:15:45     12622          
  2.       SUBROUTINE COQ8KS(AKS,XX,SHPCOQ,SHPELE,NBPGAU,POIGAU,
  3.      1 DZEGAU,ES,SIGGAU,NBNN,LRE,LRI,RI)
  4. C==============================================================
  5. C    MATRICE DES CONTRAINTES INITIALES  COQ8 ET COQ6
  6. C ENTREES
  7. C    XX(3,NBNN)  = COORDONNEES DE L ELELEMENT
  8. C    SHPCOQ(6,NBNN,NBPGAU) = FONCTIONS DE FORME POINTS DE CONTRAINTES
  9. C    SHPELE(6,NBNN,NBNN) = FONCTIONS DE FORME NOEUDS
  10. C    NBPGAU              = NOMBRE DE POINTS  DE GAUSS
  11. C    POIGAU(NBPGAU)      = POIDS D INTEGRATION
  12. C    DZEGAU(NBPGAU)      = TROISIEME COORDONNEE REDUITE
  13. C    ES(NBNN)            = EPAISSEURS
  14. C    SIGGAU(5*NBPGAU)    = LES CONTRAINTES
  15. C    NBNN                = NOMBRE DE NOEUDS
  16. C    LRE                 = NOMBRE DE D.D.L. ( NBNN*6)
  17. C    LRI                 = NOMBRE DE D.D.L. REDUITS ( NBNN*5)
  18. C TABLEAU DE TRAVAIL
  19. C    RI(LRI,LRI)         = TABLEAU DE TRAVAIL
  20. C SORTIES
  21. C    AKS(LRE,LRE)        = MATRICE DES CONTRAINTES INITIALES
  22. C
  23. C=================================================================
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.       PARAMETER(XZER=0.D0,UN=1.D0,UNDEMI=.5D0)
  27.       DIMENSION AKS(LRE,*),XX(3,*),SHPCOQ(6,NBNN,*),SHPELE(6,NBNN,*)
  28.       DIMENSION POIGAU(*),DZEGAU(*)
  29.       DIMENSION SIGGAU(*),ES(*),RI(LRI,*)
  30.       DIMENSION H(8),P(2,8),TH(8),XJ(3,3),XJI(3,3)
  31.       DIMENSION XJIT(3,3),TET(3,3),TT(9),TE(3,3),SIG(3,3),SIGT(3,3)
  32.       DIMENSION SI(3,3),A(3,8),V2V1(3,2),V2V1T(2,3),RIP(2,2)
  33.       DIMENSION VR(3,2),AKSP(3,3),TXR(3,3,8)
  34.       DIMENSION AMA1(3,3),AMA2(3,3),AMA3(3,3)
  35. C
  36. C
  37.       EQUIVALENCE(TET(1,1),TT(1))
  38. C
  39. C        OBJET  MATRICE DE RIGIDITE GEOMETRIQUE ELEMENTAIRE
  40. C
  41.       DO 5 I=1,NBNN
  42.       TH(I)=ES(I)
  43.     5 CONTINUE
  44.       DO 242 I=1,LRE
  45.       DO 10 J=1,LRE
  46.       AKS(I,J)=XZER
  47.    10 CONTINUE
  48.   242 CONTINUE
  49.       CALL CQ8LOC(XX,NBNN,SHPELE,TXR,IRR)
  50.       DO 50 NGAU=1,NBPGAU
  51.       DO 20 I=1,NBNN
  52.       H(I)  =SHPCOQ(1,I,NGAU)
  53.       P(1,I)=SHPCOQ(2,I,NGAU)
  54.       P(2,I)=SHPCOQ(3,I,NGAU)
  55.  20   CONTINUE
  56.       DO 243 I=1,LRI
  57.       DO 11 J=1,LRI
  58.       RI(I,J)=XZER
  59.  11   CONTINUE
  60.   243 CONTINUE
  61.       E3=DZEGAU(NGAU)
  62.       WT=POIGAU(NGAU)
  63.       CALL COQ8JC(NGAU,NBNN,E3,XX,TH,TXR,SHPCOQ,XJ,DET,IRR)
  64.       FACT=WT*DET
  65. C
  66. C       INVERSION DE LA MATRICE JACOBIENNE
  67. C
  68.       DUM= UN/DET
  69.       XJI(1,1)=DUM*( XJ(2,2)*XJ(3,3)-XJ(2,3)*XJ(3,2))
  70.       XJI(2,1)=DUM*(-XJ(2,1)*XJ(3,3)+XJ(2,3)*XJ(3,1))
  71.       XJI(3,1)=DUM*( XJ(2,1)*XJ(3,2)-XJ(2,2)*XJ(3,1))
  72.       XJI(1,2)=DUM*(-XJ(1,2)*XJ(3,3)+XJ(1,3)*XJ(3,2))
  73.       XJI(2,2)=DUM*( XJ(1,1)*XJ(3,3)-XJ(1,3)*XJ(3,1))
  74.       XJI(3,2)=DUM*(-XJ(1,1)*XJ(3,2)+XJ(1,2)*XJ(3,1))
  75.       XJI(1,3)=DUM*( XJ(1,2)*XJ(2,3)-XJ(1,3)*XJ(2,2))
  76.       XJI(2,3)=DUM*(-XJ(1,1)*XJ(2,3)+XJ(1,3)*XJ(2,1))
  77.       XJI(3,3)=DUM*( XJ(1,1)*XJ(2,2)-XJ(1,2)*XJ(2,1))
  78. C
  79. C       CALCUL DE J-1 TRANSPOSEE
  80. C
  81.       DO 244 I=1,3
  82.       DO 30 J=1,3
  83.       XJIT(I,J)=XJI(J,I)
  84.  30   CONTINUE
  85.   244 CONTINUE
  86. C
  87. C  CALCUL DE TET MATRICE DE LA ROTATION LOCALE AU POINT DE GAUSS
  88. C
  89.       DO 245 I=1,3
  90.       DO 31 J=1,2
  91.       TET(I,J)=XJ(J,I)
  92.  31   CONTINUE
  93.   245 CONTINUE
  94.       CALL CROSS2(TT(1),TT(4),TT(7),IERR)
  95.       CALL CROSS2(TT(7),TT(1),TT(4),IERR)
  96.       CALL CROSS2(TT(4),TT(7),TT(1),IERR)
  97. C
  98. C       TE EST LA TRANSPOSEE DE TET
  99. C
  100.       DO 246 I=1,3
  101.       DO 32 J=1,3
  102.       TE(I,J)=TET(J,I)
  103.  32    CONTINUE
  104.   246 CONTINUE
  105. C
  106. C       ON RECUPERE LES CONTRAINTES D UN POINT DE GAUSS
  107. C
  108.       SIG(1,1)=SIGGAU((NGAU-1)*5+1)
  109.       SIG(2,2)=SIGGAU((NGAU-1)*5+2)
  110.       SIG(1,2)=SIGGAU((NGAU-1)*5+3)
  111.       SIG(1,3)=SIGGAU((NGAU-1)*5+4)
  112.       SIG(2,3)=SIGGAU((NGAU-1)*5+5)
  113.       SIG(2,1)=SIG(1,2)
  114.       SIG(3,2)=SIG(2,3)
  115.       SIG(3,1)=SIG(1,3)
  116.       SIG(3,3)=XZER
  117. C
  118. C       CALCUL DE SIGT=TET*SIG*TE
  119. C
  120.       CALL MULMAT(AMA1,XJIT,TET,3,3,3)
  121.       CALL MULMAT(AMA2,AMA1,SIG,3,3,3)
  122.       CALL MULMAT(AMA3,AMA2,TE,3,3,3)
  123.       CALL MULMAT(SIGT,AMA3,XJI,3,3,3)
  124. C
  125. C       CALCUL DES TERMES RELATIFS AU NOEUD I,J
  126. C
  127.       DO 40 I=1,NBNN
  128.       DO 100 J=I,NBNN
  129.       A(1,I)=P(1,I)*E3*TH(I)*UNDEMI
  130.       A(2,I)=P(2,I)*E3*TH(I)*UNDEMI
  131.       A(1,J)=P(1,J)*E3*TH(J)*UNDEMI
  132.       A(2,J)=P(2,J)*E3*TH(J)*UNDEMI
  133.       A(3,I)=H(I)*TH(I)*UNDEMI
  134.       A(3,J)=H(J)*TH(J)*UNDEMI
  135. C
  136.       DO 116 K=1,3
  137.       IK=5*(I-1)+K
  138.       JK=5*(J-1)+K
  139.       DO 247 M=1,2
  140.       DO 200 N=1,2
  141.       RI(IK,JK)=RI(IK,JK)+SIGT(M,N)*P(M,I)*P(N,J)
  142.  200  CONTINUE
  143.   247 CONTINUE
  144. 116   CONTINUE
  145. C
  146.       DO 248 K=1,3
  147.       IS=-1
  148.       DO 117 L=4,5
  149.       LL=L-3
  150. C
  151. C
  152.       IK=5*(I-1)+K
  153.       JL=5*(J-1)+L
  154.       IS=-IS
  155.       DO 249 M=1,2
  156.       DO 210 N=1,3
  157.       RI(IK,JL)=RI(IK,JL)+SIGT(M,N)*P(M,I)*TXR(K,LL,J)*A(N,J)*IS
  158.  210  CONTINUE
  159.   249 CONTINUE
  160. 117   CONTINUE
  161.   248 CONTINUE
  162.       IS=-1
  163. C
  164.       DO 250 K=4,5
  165.       IS=-IS
  166.       DO 119 L=1,3
  167.       IK=5*(I-1)+K
  168.       JL=5*(J-1)+L
  169.       KK=K-3
  170.       DO 251 N=1,2
  171.       DO 230 M=1,3
  172.       RI(IK,JL)=RI(IK,JL)+SIGT(M,N)*P(N,J)*TXR(L,KK,I)*A(M,I)*IS
  173.  230  CONTINUE
  174.   251 CONTINUE
  175. 119   CONTINUE
  176.   250 CONTINUE
  177.       IS=1
  178. C
  179.       DO 252 K=4,5
  180.       IS=-IS
  181.       DO 121 L=4,5
  182.       IS=-IS
  183.       KK=K-3
  184.       LL=L-3
  185.       IK=5*(I-1)+K
  186.       JL=5*(J-1)+L
  187.       COE1=XZER
  188.       COE2=XZER
  189.       DO 253 M=1,3
  190.       DO 240 N=1,3
  191.       COE1=COE1+SIGT(M,N)*A(M,I)*A(N,J)
  192.  240  CONTINUE
  193.   253 CONTINUE
  194.       DO 241 MM=1,3
  195.       COE2=COE2+TXR(MM,KK,I)*TXR(MM,LL,J)
  196.  241  CONTINUE
  197.        RI(IK,JL)=COE1*COE2*IS
  198. 121   CONTINUE
  199.   252 CONTINUE
  200. C
  201. C       CHANGEMENT DE VARIABLE ROTATIONS LOCALES-GLOBALES
  202. C                  ET INTEGRATION
  203. C
  204.       DO 254 K=1,3
  205.       DO 130 L=1,3
  206.       IK6=6*(I-1)+K
  207.       JL6=6*(J-1)+L
  208.       IK5=5*(I-1)+K
  209.       JL5=5*(J-1)+L
  210.       AKS(IK6,JL6)=AKS(IK6,JL6)+FACT*RI(IK5,JL5)
  211. 130   CONTINUE
  212.   254 CONTINUE
  213. C
  214. 100   CONTINUE
  215.  40   CONTINUE
  216.  50   CONTINUE
  217. C
  218.       DO 255 I=1,LRE
  219.       DO 150 J=1,I
  220.       AKS(I,J)=AKS(J,I)
  221. 150   CONTINUE
  222.   255 CONTINUE
  223. C
  224.       RETURN
  225.       END
  226.  
  227.  
  228.  

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