Télécharger bcoq8e.eso

Retour à la liste

Numérotation des lignes :

  1. C BCOQ8E SOURCE CHAT 05/01/12 21:37:36 5004
  2. SUBROUTINE BCOQ8E(NOBG,XX,NBNN,TH,EXC,B,DET,E,SHPCOQ,TXR,IRR)
  3. C=======================================================================
  4. C ROUTINE EQUIVALENTE A BCOQ8 AVEC EXCENTREMENT.
  5. C ENTREES
  6. C NOBG : NUMERO DU POINT DE GAUSS
  7. C XX(3,NBNN) : TABLEAU DES COORDONNEES DES NOEUDS
  8. C NBNN : NOMBRE DE NOEUDS
  9. C TH(NBNN) : TABLEAU DES EPAISSEURS
  10. C EXC(NBNN) : TABLEAU DES EXCENTREMENTS
  11. C E : COORDONNEE REDUITE DU POINT DE GAUSS DANS
  12. C L EPAISSEUR
  13. C SHPCOQ(6,NBNN,NBPGAU) : FONCTIONS DE FORME ET DERIVESS AUX PTS DE GSS
  14. C TXR(3,3,NBNN): TABLEAU DE CHGMT DE REPERE ENTRE NOEUD ET REP.
  15. C GLOBAL
  16. C SORTIES
  17. C B(5,LRE): MATRICE B
  18. C DET : DETERMINANT DU JACOBIEN
  19. C IRR : INDICATEUR DE SUCCES ( 1 ) , D ECHEC (0 OU-1)
  20. C INSPIRE DE SHLMSD DE BILBO JUILLET 86
  21. C=======================================================================
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8 (A-H,O-Z)
  24. PARAMETER(UN=1.D0,UNDEMI=.5D0,XZER=0.D0)
  25. DIMENSION XX(3,*),TH(*),EXC(*),B(5,*),SHPCOQ(6,NBNN,*),TXR(3,3,*)
  26. DIMENSION XJ(3,3),XJI(3,3),BI(5,3),BT(5,3),TT(9)
  27. C*
  28. C* DETERMINATION DU JACOBIEN ET DE SON DETERMINANT AU POINT (R,S,T)
  29. C*
  30. CALL CQ8JCE(NOBG,NBNN,E,XX,TH,EXC,TXR,SHPCOQ,XJ,DET,IRR)
  31. C
  32. IF(IRR.EQ.-1) RETURN
  33.  
  34. C*
  35. C* DETERMINATION DES COSINUS DIRECTEURS DES AXES LOCAUX EN CE POINT
  36. C*
  37. DO 10 I=1,3
  38. DO 10 J=1,2
  39. K=3*(J-1)+I
  40. TT(K) = XJ(J,I)
  41. 10 CONTINUE
  42. C*
  43. C* PRODUITS VECTORIELS ET NORMALISATIONS
  44. C*
  45. CALL CROSS2(TT(1),TT(4),TT(7),IRR)
  46. CALL CROSS2(TT(7),TT(1),TT(4),IRR)
  47. CALL CROSS2(TT(4),TT(7),TT(1),IRR)
  48. C
  49. IF(IRR.EQ.0) RETURN
  50. C*
  51. C* INVERSION DU JACOBIEN
  52. C*
  53. DUM =UN/DET
  54. XJI(1,1) = DUM*( XJ(2,2)*XJ(3,3) - XJ(2,3)*XJ(3,2))
  55. XJI(2,1) = DUM*(-XJ(2,1)*XJ(3,3) + XJ(2,3)*XJ(3,1))
  56. XJI(3,1) = DUM*( XJ(2,1)*XJ(3,2) - XJ(2,2)*XJ(3,1))
  57. XJI(1,2) = DUM*(-XJ(1,2)*XJ(3,3) + XJ(1,3)*XJ(3,2))
  58. XJI(2,2) = DUM*( XJ(1,1)*XJ(3,3) - XJ(1,3)*XJ(3,1))
  59. XJI(3,2) = DUM*(-XJ(1,1)*XJ(3,2) + XJ(1,2)*XJ(3,1))
  60. XJI(1,3) = DUM*( XJ(1,2)*XJ(2,3) - XJ(1,3)*XJ(2,2))
  61. XJI(2,3) = DUM*(-XJ(1,1)*XJ(2,3) + XJ(1,3)*XJ(2,1))
  62. XJI(3,3) = DUM*( XJ(1,1)*XJ(2,2) - XJ(1,2)*XJ(2,1))
  63. C*
  64. C* PRODUIT MATRICIEL TT TRANSPOSE * XJI
  65. C*
  66. DO 20 I=1,3
  67. DO 20 J=1,3
  68. XJ(I,J)=XZER
  69. DO 20 K=1,3
  70. K1=3*(I-1)+K
  71. XJ(I,J) = XJ(I,J)+TT(K1)*XJI(K,J)
  72. 20 CONTINUE
  73. C*
  74. C* DETERMINATION DES COEFFICIENTS DES DEPLACEMENTS
  75. C*
  76. DO 100 I=1,NBNN
  77. B1=XJ(1,1)*SHPCOQ(2,I,NOBG) +XJ(1,2)*SHPCOQ(3,I,NOBG)
  78. B2=XJ(2,1)*SHPCOQ(2,I,NOBG) +XJ(2,2)*SHPCOQ(3,I,NOBG)
  79. DO 30 J=1,5
  80. DO 30 K=1,3
  81. BI(J,K)=XZER
  82. 30 CONTINUE
  83. BI(1,1) = B1
  84. BI(2,2) = B2
  85. BI(3,1) = B2
  86. BI(3,2) = B1
  87. BI(4,3) = B1
  88. BI(5,3) = B2
  89. C
  90. C DANS BILBO, BI(4,3)=B2 ET BI(5,3)=B1
  91. C
  92. DO 35 J=1,5
  93. DO 35 K=1,3
  94. KK=6*(I-1)+K
  95. B(J,KK)=XZER
  96. DO 35 L=1,3
  97. K1=3*(L-1)+K
  98. 35 B(J,KK) = B(J,KK)+BI(J,L)*TT(K1)
  99. C*
  100. C* DETERMINATION DES COEFFICIENTS DES ROTATIONS
  101. C*
  102. DUM = XJ(3,3)*SHPCOQ(1,I,NOBG)
  103. DO 40 J=1,5
  104. DO 40 K=1,3
  105. 40 BI(J,K) = BI(J,K)
  106. BI(4,1)=DUM
  107. BI(5,2)=DUM
  108. C
  109. C DANS BILBO, DUM=BI(4,2)=BI(5,1)
  110. C
  111. DO 45 J=1,5
  112. DO 45 K=1,3
  113. BI(J,K) = BI(J,K)*UNDEMI*TH(I)*E + BI(J,K)*EXC(I)
  114. 45 CONTINUE
  115. BI(4,1)=DUM*UNDEMI*TH(I)
  116. BI(5,2)=DUM*UNDEMI*TH(I)
  117. C
  118. DO 50 J=1,5
  119. DO 50 K=1,3
  120. BT(J,K) = XZER
  121. DO 50 L=1,3
  122. K1=3*(L-1)+K
  123. BT(J,K) = BT(J,K) + BI(J,L)*TT(K1)
  124. 50 CONTINUE
  125. C
  126. DO 60 J=1,3
  127. 60 XJI(J,J)= XZER
  128. XJI(1,2) = TXR(1,1,I)*TXR(2,2,I)-TXR(2,1,I)*TXR(1,2,I)
  129. XJI(1,3) = TXR(1,1,I)*TXR(3,2,I)-TXR(1,2,I)*TXR(3,1,I)
  130. XJI(2,3) = TXR(2,1,I)*TXR(3,2,I)-TXR(2,2,I)*TXR(3,1,I)
  131. DO 70 J=1,3
  132. DO 70 K=J,3
  133. XJI(K,J) =-XJI(J,K)
  134. 70 CONTINUE
  135. C
  136. DO 80 J=1,5
  137. DO 80 K=1,3
  138. KK = 6*I+K-3
  139. B(J,KK)= XZER
  140. DO 80 L=1,3
  141. B(J,KK) = B(J,KK)+BT(J,L)*XJI(L,K)
  142. 80 CONTINUE
  143. 100 CONTINUE
  144. RETURN
  145. END
  146.  
  147.  

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