Télécharger cqtgr2.eso

Retour à la liste

Numérotation des lignes :

  1. C CQTGR2 SOURCE CHAT 05/01/12 22:27:38 5004
  2. SUBROUTINE CQTGR2(XE,NBNN,NBPGAU,LRE,EPAIST,DZEGAU,SHPCOQ,
  3. 1 SHPELE,XDDL,XDDL1,GRADI)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. C |=====================================================================
  7. C | SOUS-PROGRAMME DE L'OPERATEUR GRADIENT (APPELE PAR GRAD1)
  8. C | CALCUL DU GRADIENT DE TEMPERATURE POUR LES ELEMENT COQ4,COQ6,COQ8
  9. C |== ENTREES
  10. C | XX(3,NBNN): TABLEAU DES COORDONNEES DES NOEUDS
  11. C | NBNN : NOMBRE DE NOUDS
  12. C | NBPGAU : NOMBRE DE POINTS DE GAUSS
  13. C | LRE : NOMBRE DE DDL
  14. C | EPAIST : EPAISSEUR DE LA COQUE
  15. C | DZEGAU(NBPGAU): COORDONNEES REDUITES DES POIN
  16. C | DE GAUSS DANS L EPAISSEUR
  17. C | SHPCOQ(6,NBNN,NBPGAU) :FONCTIONS DE FORME ET DERIVEES
  18. C | AUX POINTS DE GAUSS
  19. C | SHPELE(6,NBNN,NBNN) :FONCTIONS DE FORME ET DERIVEES AUX NOEUDS
  20. C | XDDL(LRE): TEMPERATURES AU NOEUDS
  21. C | XDDL1(LRE): TABLEAU DE TRAVAIL
  22. C |== SORTIES
  23. C | GRADI(2*NBPGAU):2 TERMS DE GRADIANT AUX NBPGAU POINTS DE GAUSS
  24. C | AUTEUR : P. DOWLATYARI 30/5/91
  25. C |=====================================================================
  26. -INC CCOPTIO
  27. DIMENSION DZEGAU(*),SHPCOQ(6,NBNN,*),SHPELE(6,NBNN,*)
  28. DIMENSION XE(3,*),GRADI(*),XDDL(*),XDDL1(*)
  29. DIMENSION TXR(3,3,8),BGR(2,24),TH(8),TT(9),EXC(8)
  30. DIMENSION XJ(3,3),XJI(3,3)
  31. PARAMETER (XZERO=0.D0,UN=1.D0,DEUX=2.D0)
  32. C
  33. C CALCUL DES AXES LOCAUX A TOUS LES NOEUDS
  34. C
  35. CALL CQ8LOC(XE,NBNN,SHPELE,TXR,IRR)
  36. IF(IRR.EQ.0)THEN
  37. CALL ERREUR(515)
  38. RETURN
  39. ENDIF
  40. C
  41. DO 10 I=1,NBNN
  42. TH(I)=EPAIST
  43. EXC(I)=0.D0
  44. 10 CONTINUE
  45. C
  46. C ON REORDONNE LES COMPOSANTES DE TEMPERATURES ET ON
  47. C LES MET DANS XDDL1
  48. C
  49. DO 11 I=1,LRE
  50. JJ=(I-1)/NBNN
  51. KK=I-JJ*NBNN
  52. II=(KK-1)*3+JJ+1
  53. XDDL1(I)=XDDL(II)
  54. 11 CONTINUE
  55. C
  56. C BOUCLE SUR LES POINTS DE GAUSS
  57. C
  58. C
  59. DO 100 IGAU=1,NBPGAU
  60. CALL ZERO(BGR,2,LRE)
  61. C
  62. C CALCUL DU JACOBIEN ET DE SON DETERMINENT EN CE POINT DE GAUSS
  63. C
  64. E3=DZEGAU(IGAU)
  65. CALL CQ8JCE(IGAU,NBNN,E3,XE,TH,EXC,TXR,SHPCOQ,XJ,DJAC,IRR)
  66. IF (IRR.LT.0)THEN
  67. * JACOBIEN NUL DANS L'ELEMENT IEL
  68. INTERR(1)=0
  69. CALL ERREUR (405)
  70. RETURN
  71. ENDIF
  72. *
  73. * INVERSION DU JACOBIEN
  74. *
  75. DUM =UN/DJAC
  76. XJI(1,1) = DUM*( XJ(2,2)*XJ(3,3) - XJ(2,3)*XJ(3,2))
  77. XJI(2,1) = DUM*(-XJ(2,1)*XJ(3,3) + XJ(2,3)*XJ(3,1))
  78. XJI(3,1) = DUM*( XJ(2,1)*XJ(3,2) - XJ(2,2)*XJ(3,1))
  79. XJI(1,2) = DUM*(-XJ(1,2)*XJ(3,3) + XJ(1,3)*XJ(3,2))
  80. XJI(2,2) = DUM*( XJ(1,1)*XJ(3,3) - XJ(1,3)*XJ(3,1))
  81. XJI(3,2) = DUM*(-XJ(1,1)*XJ(3,2) + XJ(1,2)*XJ(3,1))
  82. XJI(1,3) = DUM*( XJ(1,2)*XJ(2,3) - XJ(1,3)*XJ(2,2))
  83. XJI(2,3) = DUM*(-XJ(1,1)*XJ(2,3) + XJ(1,3)*XJ(2,1))
  84. XJI(3,3) = DUM*( XJ(1,1)*XJ(2,2) - XJ(1,2)*XJ(2,1))
  85. *
  86. * DETERMINATION DES COSINUS DIRECTEURS DES AXES LOCAUX EN CE POINT
  87. *
  88. * COQ8 COQ6
  89. IF(NBNN.EQ.8.OR.NBNN.EQ.6)THEN
  90. *
  91. DO 20 I=1,3
  92. DO 20 J=1,2
  93. K=3*(J-1)+I
  94. TT(K) = XJ(J,I)
  95. 20 CONTINUE
  96. *
  97. * PRODUITS VECTORIELS ET NORMALISATIONS
  98. *
  99. CALL CROSS2(TT(1),TT(4),TT(7),IRR)
  100. CALL CROSS2(TT(7),TT(1),TT(4),IRR)
  101. CALL CROSS2(TT(4),TT(7),TT(1),IRR)
  102. *
  103. ELSE
  104. IF(IGAU.EQ.1)THEN
  105. *
  106. * CALCUL DES AXES LOCAUX DE L 'ELEMENT COQ4
  107. *
  108. * DIAGONALE 1
  109. *
  110. TT(1)=XE(1,3)-XE(1,1)
  111. TT(2)=XE(2,3)-XE(2,1)
  112. TT(3)=XE(3,3)-XE(3,1)
  113. *
  114. * DIAGONALE 2
  115. *
  116. TT(4)=XE(1,4)-XE(1,2)
  117. TT(5)=XE(2,4)-XE(2,2)
  118. TT(6)=XE(3,4)-XE(3,2)
  119. *
  120. * NORMALE AUX 2 DIAGONALES
  121. *
  122. CALL CROSS2(TT(1),TT(4),TT(7),IRR)
  123. *
  124. TT(1)=XE(1,2)-XE(1,1)
  125. TT(2)=XE(2,2)-XE(2,1)
  126. TT(3)=XE(3,2)-XE(3,1)
  127. *
  128. CALL CROSS2(TT(7),TT(1),TT(4),IRR)
  129. CALL CROSS2(TT(4),TT(7),TT(1),IRR)
  130. *
  131. ENDIF
  132. ENDIF
  133. IF(IRR.EQ.0) THEN
  134. * ECHEC DANS LE CALCUL DES AXES LOCAUX
  135. CALL ERREUR(515)
  136. RETURN
  137. ENDIF
  138. *
  139. *
  140. * PRODUIT MATRICIEL TT TRANSPOSE * XJI
  141. *
  142. DO 30 I=1,3
  143. DO 30 J=1,3
  144. XJ(I,J)=XZERO
  145. DO 30 K=1,3
  146. K1=3*(I-1)+K
  147. XJ(I,J) = XJ(I,J)+TT(K1)*XJI(K,J)
  148. 30 CONTINUE
  149. *
  150. * CALCUL DE LA MATRICE DE GRADIENT DES FONCTIONS DE FORME
  151. * DANS LE REPERE LOCAL
  152. *
  153. NBNN2=2*NBNN
  154. DO 40 K = 1,LRE
  155. DO 40 I = 1,2
  156. DO 40 J = 1,3
  157. JJ=J+1
  158. IF(JJ.EQ.4)JJ=1
  159. IF(K.LE.NBNN)THEN
  160. KK=K
  161. IF(J.LE.2)THEN
  162. COEF=(E3/DEUX)*(E3-UN)
  163. ELSE
  164. COEF=E3-UN/DEUX
  165. ENDIF
  166. ELSEIF(K.GT.NBNN.AND.K.LE.NBNN2)THEN
  167. KK=K-NBNN
  168. IF(J.LE.2)THEN
  169. COEF=UN-E3*E3
  170. ELSE
  171. COEF=-DEUX*E3
  172. ENDIF
  173. ELSE
  174. KK=K-NBNN2
  175. IF(J.LE.2)THEN
  176. COEF=(E3/DEUX)*(E3+UN)
  177. ELSE
  178. COEF=E3+UN/DEUX
  179. ENDIF
  180. ENDIF
  181. BGR(I,K)=BGR(I,K)+COEF*SHPCOQ(JJ,KK,IGAU)*XJ(I,J)
  182. 40 CONTINUE
  183. C
  184. C CALCUL DE BGR*XDDL
  185. C
  186. IG=(IGAU-1)*2+1
  187. CALL BGRDEP(BGR,2,XDDL1,LRE,GRADI(IG))
  188. C
  189. 100 CONTINUE
  190. C
  191. RETURN
  192. END
  193.  
  194.  

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