Télécharger bgrcq8.eso

Retour à la liste

Numérotation des lignes :

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

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