Télécharger fscoq8.eso

Retour à la liste

Numérotation des lignes :

  1. C FSCOQ8 SOURCE FANDEUR 12/07/18 21:15:39 7434
  2.  
  3. SUBROUTINE FSCOQ8(IPT,IPMAIL,IPTINT,IPVECT,VEC,IVACAR,
  4. & IPTNOE,IVAFOR)
  5. *______________________________________________________________________
  6. *
  7. * CALCULE LES FORCES SURFACIQUES AUX NOEUDS DES COQUES COQ8, COQ6
  8. *
  9. *
  10. * ENTREES :
  11. * ---------
  12. *
  13. * IPT TABLEAU DE POINTEURS SUR MPTVAL CONTENANT LES FORCES
  14. * APPLIQUEES
  15. * IPMAIL POINTEUR SUR LE MAILLAGE
  16. * IPTINT POINTEUR SUR LE CHAMELEM DE L'INTEGRATION
  17. * IPVECT POINTEUR SUR LE VECTEUR REPRESENTANT LA FORCE
  18. * VEC VECTEUR REPRESENTANT LA FORCE
  19. * IVACAR POINTEUR SUR UN SEGMENT MPTVAL CONCERNANT LES CARAC-
  20. * TERISTIQUES (EPAISSEUR AUX NOEUDS)
  21. * IPTNOE POINTEUR SUR L'ALIAS DU CHAMELEM D'INTEGRATION CONTENANT
  22. * LES FONCTIONS DE FORME AUX NOEUDS
  23. * IVAFOR POINTEUR SUR UN MPTVAL ET MELVALS ASSOCIEES AUX FORCES
  24. * ET MOMENTS AUX NOEUDS
  25. *
  26. *_______________________________________________________________________
  27. *
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8(A-H,O-Z)
  30. *
  31. -INC CCOPTIO
  32. *
  33. -INC SMCHAML
  34. -INC SMELEME
  35. -INC SMINTE
  36. -INC SMCOORD
  37. *
  38. SEGMENT MPTVAL
  39. INTEGER IPOS(NS) ,NSOF(NS)
  40. INTEGER IVAL(NCOSOU)
  41. CHARACTER*16 TYVAL(NCOSOU)
  42. ENDSEGMENT
  43. *
  44. DIMENSION IPT(*),VEC(*)
  45. *
  46. DIMENSION TH(8),XJ(3,3),TXR(3,3,8),XE(3,8)
  47. *
  48. MELVA1 = IPT(1)
  49. MELVA2 = IPT(2)
  50. MELVA3 = IPT(3)
  51. IF (IPVECT.EQ.0) THEN
  52. IBM1 = 0
  53. IF (MELVA1.NE.0) THEN
  54. SEGACT,MELVA1
  55. IGM1 = MELVA1.VELCHE(/1)
  56. IBM1 = MELVA1.VELCHE(/2)
  57. ENDIF
  58. IBM2 = 0
  59. IF (MELVA2.NE.0) THEN
  60. SEGACT,MELVA2
  61. IGM2 = MELVA2.VELCHE(/1)
  62. IBM2 = MELVA2.VELCHE(/2)
  63. ENDIF
  64. IBM3 = 0
  65. IF (MELVA3.NE.0) THEN
  66. SEGACT,MELVA3
  67. IGM3 = MELVA3.VELCHE(/1)
  68. IBM3 = MELVA3.VELCHE(/2)
  69. ENDIF
  70. F1 = 0.D0
  71. F2 = 0.D0
  72. F3 = 0.D0
  73. ELSE
  74. F1 = VEC(1)
  75. F2 = VEC(2)
  76. F3 = VEC(3)
  77. ENDIF
  78. *
  79. MINTE=IPTINT
  80. C* SEGACT,MINTE <- ACTIF EN E/S
  81. NBPGAU=POIGAU(/1)
  82. NBGAU2=NBPGAU/2
  83. *
  84. MINTE1=IPTNOE
  85. SEGACT,MINTE1
  86. *
  87. MELEME=IPMAIL
  88. C* SEGACT,MELEME <- ACTIF EN E/S
  89. NBNN = NUM(/1)
  90. NBELEM= NUM(/2)
  91. C*
  92. C* PREPARATION DE DONNEES POUR LE CALCUL DE L'EPAISSEUR D'UN ELEMENT
  93. C*
  94. MPTVAL = IVACAR
  95. MELVEP = IVAL(1)
  96. MELVAL = MELVEP
  97. C* SEGACT,MELVAL <- ACTIF EN E/S
  98. IGEP = VELCHE(/1)
  99. IBEP = VELCHE(/2)
  100. C* IF (IGEP.LT.1) THEN
  101. C* WRITE(IOMP,*) 'ERREUR : FSCOQ8 - IGEP'
  102. C* CALL ERREUR(5)
  103. C* RETURN
  104. C* ENDIF
  105. *
  106. MPTVAL = IVAFOR
  107. *
  108. * BOUCLE SUR LES ELEMENTS
  109. *
  110. DO 1 IB = 1, NBELEM
  111. *
  112. * CALCUL DE L EPAISSEUR MOYENNE
  113. * CALCUL DE TH(IPTELE)
  114. *
  115. MELVAL = MELVEP
  116. IBMN = MIN(IB,IBEP)
  117. EPAI = VELCHE(1,IBMN)
  118. IF (IGEP.GT.1) THEN
  119. DO i = 2, IGEP
  120. EPAI = EPAI + VELCHE(i,IBMN)
  121. ENDDO
  122. EPAI = EPAI / IGEP
  123. ENDIF
  124. * ON STOCKE L'EPAISSEUR MOYENNE A CHAQUE NOEUD (UTILE POUR LES CALCULS)
  125. DO i = 1, NBNN
  126. TH(i) = EPAI
  127. ENDDO
  128. *
  129. * DETERMINATION DES REPERES LOCAUX AUX NOEUDS
  130. *
  131. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  132. CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,TXR,irr)
  133. *
  134. IF (IPVECT.EQ.0) THEN
  135. IF (MELVA1.NE.0) IBMN1 = MIN(IB,IBM1)
  136. IF (MELVA2.NE.0) IBMN2 = MIN(IB,IBM2)
  137. IF (MELVA3.NE.0) IBMN3 = MIN(IB,IBM3)
  138. ENDIF
  139. *
  140. * BOUCLE SUR LES POINTS DE GAUSS
  141. *
  142. DO 10 IGAU = 1, NBGAU2
  143. *
  144. IF (IPVECT.EQ.0) THEN
  145. IF (MELVA1.NE.0) THEN
  146. IGMN = MIN(IGAU,IGM1)
  147. F1 = MELVA1.VELCHE(IGMN,IBMN1)
  148. ENDIF
  149. IF (MELVA2.NE.0) THEN
  150. IGMN = MIN(IGAU,IGM2)
  151. F2 = MELVA2.VELCHE(IGMN,IBMN2)
  152. ENDIF
  153. IF (MELVA3.NE.0) THEN
  154. IGMN = MIN(IGAU,IGM3)
  155. F3 = MELVA3.VELCHE(IGMN,IBMN3)
  156. ENDIF
  157. ENDIF
  158. *
  159. * VECTEUR NORMAL A LA SURFACE DE L ELEMENT AU PT DE GAUSS IGAU
  160. *
  161. CALL COQ8JC(IGAU,NBNN,1.D0,XE,TH,TXR,SHPTOT,XJ,DET,irr)
  162. *
  163. VG_1 = XJ(1,2)*XJ(2,3) - XJ(2,2)*XJ(1,3)
  164. VG_2 = XJ(1,3)*XJ(2,1) - XJ(2,3)*XJ(1,1)
  165. VG_3 = XJ(1,1)*XJ(2,2) - XJ(2,1)*XJ(1,2)
  166. VN = SQRT( VG_1*VG_1 + VG_2*VG_2 + VG_3*VG_3 )
  167. VG_1 = VG_1 / VN
  168. VG_2 = VG_2 / VN
  169. VG_3 = VG_3 / VN
  170. *
  171. SURFP = VN * POIGAU(IGAU)
  172. POI2P = 0.5D0 * POIGAU(IGAU)
  173. *
  174. * BOUCLE SUR NOEUDS DE L'ELEMENT
  175. *
  176. *
  177. DO 20 J = 1, NBNN
  178. *
  179. VQ_1 = TXR(1,1,J)
  180. VQ_2 = TXR(2,1,J)
  181. VQ_3 = TXR(3,1,J)
  182. VE_1 = TXR(1,2,J)
  183. VE_2 = TXR(2,2,J)
  184. VE_3 = TXR(3,2,J)
  185. *
  186. * Matrice de changement de repere : XJij
  187. *
  188. XJ11 = 0.D0
  189. XJ12 = VQ_1*VE_2 - VQ_2*VE_1
  190. XJ13 = VQ_1*VE_3 - VE_1*VQ_3
  191. XJ21 = -XJ12
  192. XJ22 = 0.D0
  193. XJ23 = VQ_2*VE_3 - VE_2*VQ_3
  194. XJ31 = -XJ13
  195. XJ32 = -XJ23
  196. XJ33 = 0.D0
  197. *
  198. * Chgt de repere du vecteur force (F1,F2,F3) : global -> local
  199. *
  200. F1L = VQ_1*F1 + VQ_2*F2 + VQ_3*F3
  201. F2L = VE_1*F1 + VE_2*F2 + VE_3*F3
  202. F3L = VG_1*F1 + VG_2*F2 + VG_3*F3
  203. *
  204. * FORCES AUX NOEUDS
  205. *
  206. WGTM = SURFP * SHPTOT(1,J,IGAU)
  207. *
  208. MELVAL = IVAL(1)
  209. VELCHE(J,IB) = VELCHE(J,IB)
  210. & + WGTM * (VG_1*F3L + VQ_1*F1L + VE_1*F2L)
  211.  
  212. MELVAL = IVAL(2)
  213. VELCHE(J,IB) = VELCHE(J,IB)
  214. & + WGTM * (VG_2*F3L + VQ_2*F1L + VE_2*F2L)
  215.  
  216. MELVAL = IVAL(3)
  217. VELCHE(J,IB) = VELCHE(J,IB)
  218. & + WGTM * (VG_3*F3L + VQ_3*F1L + VE_3*F2L)
  219. *
  220. * (V2JT)
  221. * MOMENTS AUX NDS = WT*P*TH(J)* (V1J,-V2J)(V1JT) *(VNGAU)
  222. * VALEURS DES MOMENTS AUX NOEUDS
  223. * Chgt de repere : local -> global
  224. *
  225. WGTM = POI2P * TH(J) * SHPTOT(1,J,IGAU)
  226. *
  227. MELVAL = IVAL(4)
  228. VGG = XJ11*VG_1 + XJ21*VG_2 + XJ31*VG_3
  229. VQG = XJ11*VQ_1 + XJ21*VQ_2 + XJ31*VQ_3
  230. VEG = XJ11*VE_1 + XJ21*VE_2 + XJ31*VE_3
  231. VELCHE(J,IB) = VELCHE(J,IB)
  232. & + WGTM * (VGG*F3L + VQG*F1L + VEG*F2L)
  233. MELVAL=IVAL(5)
  234. VGG = XJ12*VG_1 + XJ22*VG_2 + XJ32*VG_3
  235. VQG = XJ12*VQ_1 + XJ22*VQ_2 + XJ32*VQ_3
  236. VEG = XJ12*VE_1 + XJ22*VE_2 + XJ32*VE_3
  237. VELCHE(J,IB) = VELCHE(J,IB)
  238. & + WGTM * (VGG*F3L+ VQG*F1L + VEG*F2L)
  239.  
  240. MELVAL=IVAL(6)
  241. VGG = XJ13*VG_1 + XJ23*VG_2 + XJ33*VG_3
  242. VQG = XJ13*VQ_1 + XJ23*VQ_2 + XJ33*VQ_3
  243. VEG = XJ13*VE_1 + XJ23*VE_2 + XJ33*VE_3
  244. VELCHE(J,IB) = VELCHE(J,IB)
  245. & + WGTM * (VGG*F3L + VQG*F1L + VEG*F2L)
  246. 20 CONTINUE
  247.  
  248. 10 CONTINUE
  249.  
  250. 1 CONTINUE
  251.  
  252. C* SEGDES,MELEME <- ACTIF EN E/S
  253. C* SEGDES,MINTE <- ACTIF EN E/S
  254. SEGDES,MINTE1
  255. IF (IPVECT.EQ.0) THEN
  256. IF (MELVA1.NE.0) SEGDES,MELVA1
  257. IF (MELVA2.NE.0) SEGDES,MELVA2
  258. IF (MELVA3.NE.0) SEGDES,MELVA3
  259. ENDIF
  260.  
  261. RETURN
  262. END
  263.  
  264.  
  265.  

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