Télécharger fsco3d.eso

Retour à la liste

Numérotation des lignes :

  1. C FSCO3D SOURCE FANDEUR 12/07/18 21:15:38 7434
  2.  
  3. SUBROUTINE FSCO3D(IPT,IPMAIL,IPVECT,VEC, IVAFOR)
  4.  
  5. C____________________________________________________________________
  6. C
  7. C CALCULE LES FORCES SURFACIQUES POUR LES COQUES 3D
  8. C
  9. C
  10. C ENTREES :
  11. C ---------
  12. C
  13. C IPT TABLEAU DE POINTEUR SUR UN MPTVAL CONTENANT LES FORCES
  14. C APPLIQUEES
  15. C 0 SI ON A DONNE UNE FORCE CONSTANTE
  16. C IPMAIL OBJET GEOMETRIQUE
  17. C IPVECT POINTEUR SUR LE VECTEUR REPRESENTANT LA FORCE
  18. C VEC VECTEUR REPRESENTANT LA FORCE
  19. C IVAFOR POINTEUR SUR UN MPTVAL ET MELVALS ASSOCIEES AUX FORCES
  20. C NODALE RESULTANTES
  21. C____________________________________________________________________
  22. C
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8(A-H,O-Z)
  25. C
  26. -INC CCOPTIO
  27. C
  28. -INC SMCHAML
  29. -INC SMELEME
  30. -INC SMCOORD
  31. C
  32. SEGMENT MPTVAL
  33. INTEGER IPOS(NS) ,NSOF(NS)
  34. INTEGER IVAL(NCOSOU)
  35. CHARACTER*16 TYVAL(NCOSOU)
  36. ENDSEGMENT
  37. C
  38. DIMENSION VEC(*),IPT(*)
  39.  
  40. DIMENSION XE(3,3),XEL(3,3),BPSS(3,3),BB(9),FT(18),F(6)
  41. DIMENSION XX(3),YY(3)
  42. C
  43. DATA XX/0.5D0,0.5D0,0.0D0/
  44. DATA YY/0.0D0,0.5D0,0.5D0/
  45. PARAMETER (X1s3 = 0.333333333333333333333333333333333333333333D0 ,
  46. & X1s6 = 0.166666666666666666666666666666666666666667D0 )
  47. C
  48. MELVA1 = IPT(1)
  49. MELVA2 = IPT(2)
  50. MELVA3 = IPT(3)
  51. IF (IPVECT.EQ.0) THEN
  52. V1 = 0.D0
  53. V2 = 0.D0
  54. V3 = 0.D0
  55. IF (MELVA1.NE.0) THEN
  56. SEGACT,MELVA1
  57. IGM1 = MIN(3,MELVA1.VELCHE(/1))
  58. IBM1 = MELVA1.VELCHE(/2)
  59. ENDIF
  60. IF (MELVA2.NE.0) THEN
  61. SEGACT,MELVA2
  62. IGM2 = MIN(3,MELVA2.VELCHE(/1))
  63. IBM2 = MELVA2.VELCHE(/2)
  64. ENDIF
  65. IF (MELVA3.NE.0) THEN
  66. SEGACT,MELVA3
  67. IGM3 = MIN(3,MELVA3.VELCHE(/1))
  68. IBM3 = MELVA3.VELCHE(/2)
  69. ENDIF
  70. ELSE
  71. V1 = VEC(1)
  72. V2 = VEC(2)
  73. V3 = VEC(3)
  74. ENDIF
  75. C
  76. MELEME=IPMAIL
  77. C* SEGACT,MELEME (<- actif en E/S et non modifie)
  78. NBELEM = NUM(/2)
  79. C
  80. C BOUCLE SUR LES ELEMENTS
  81. C
  82. DO 1000 IB = 1, NBELEM
  83.  
  84. C Force moyenne sur l'element
  85. IF (IPVECT.EQ.0) THEN
  86. IF (MELVA1.NE.0) THEN
  87. IBMN = MIN(IB,IBM1)
  88. IF (IGM1.GT.1) THEN
  89. V1 = ( MELVA1.VELCHE(1,IBMN) + MELVA1.VELCHE(2,IBMN)
  90. & + MELVA1.VELCHE(3,IBMN) ) * X1s3
  91. ELSE
  92. V1 = MELVA1.VELCHE(1,IBMN)
  93. ENDIF
  94. ENDIF
  95. IF (MELVA2.NE.0) THEN
  96. IBMN = MIN(IB,IBM2)
  97. IF (IGM2.GT.1) THEN
  98. V2 = ( MELVA2.VELCHE(1,IBMN) + MELVA2.VELCHE(2,IBMN)
  99. & + MELVA2.VELCHE(3,IBMN) ) * X1s3
  100. ELSE
  101. V2 = MELVA2.VELCHE(1,IBMN)
  102. ENDIF
  103. ENDIF
  104. IF (MELVA3.NE.0) THEN
  105. IBMN = MIN(IB,IBM3)
  106. IF (IGM3.GT.1) THEN
  107. V3 = ( MELVA3.VELCHE(1,IBMN) + MELVA3.VELCHE(2,IBMN)
  108. & + MELVA3.VELCHE(3,IBMN) ) * X1s3
  109. ELSE
  110. V3 = MELVA3.VELCHE(1,IBMN)
  111. ENDIF
  112. ENDIF
  113. ENDIF
  114. C
  115. CALL DOXE(XCOOR,IDIM,3,NUM,IB,XE)
  116. C
  117. C MATRICE DE PASSAGE
  118. C
  119. CALL VPAST(XE,BPSS)
  120. C
  121. C COORDONNEES LOCALES
  122. C
  123. CALL VCORLC(XE,XEL,BPSS)
  124. C
  125. C chgt de repere des forces appliquees
  126. C
  127. VL1 = BPSS(1,1)*V1 + BPSS(1,2)*V2 + BPSS(1,3)*V3
  128. VL2 = BPSS(2,1)*V1 + BPSS(2,2)*V2 + BPSS(2,3)*V3
  129. VL3 = BPSS(3,1)*V1 + BPSS(3,2)*V2 + BPSS(3,3)*V3
  130. C
  131. X21 = XEL(1,2) - XEL(1,1)
  132. Y31 = XEL(2,3) - XEL(2,1)
  133. r_z = X21 * Y31 * X1s6
  134. FXT = r_z * VL1
  135. FYT = r_z * VL2
  136. SURFZ = r_z * VL3
  137. C
  138. C MISE A 0 DU VECTEUR FORCE
  139. C
  140. DO I = 1, 18
  141. FT(I) = 0.D0
  142. ENDDO
  143. C
  144. C INTEGRATION NUMERIQUE : IGAU NUMERO DU POINT DE GAUSS
  145. C IA NUMERO D UN NOEUD
  146. C
  147. DO 200 IGAU = 1, 3
  148. CALL MFDKT(XX(IGAU),YY(IGAU),XEL,BB)
  149. DO 210 IA = 1, 3
  150. IK = (IA-1)*3
  151. IP = IK*2+2
  152. FT(IP-1) = FXT
  153. FT(IP ) = FYT
  154. FT(IP+1) = FT(IP+1) + SURFZ*BB(IK+1)
  155. FT(IP+2) = FT(IP+2) + SURFZ*BB(IK+2)
  156. FT(IP+3) = FT(IP+3) + SURFZ*BB(IK+3)
  157. 210 CONTINUE
  158. 200 CONTINUE
  159. C
  160. C CHANGEMENT DE REPERE
  161. C
  162. MPTVAL = IVAFOR
  163. DO 400 I = 1, 3
  164. KP = 6 * (I-1)
  165. DO 402 J = 1,3
  166. MELVAL = IVAL(J)
  167. VELCHE(I,IB) = BPSS(1,J)*FT(1+KP) + BPSS(2,J)*FT(2+KP)
  168. & + BPSS(3,J)*FT(3+KP)
  169. MELVAL = IVAL(J+3)
  170. VELCHE(I,IB) = BPSS(1,J)*FT(4+KP) + BPSS(2,J)*FT(5+KP)
  171. & + BPSS(3,J)*FT(6+KP)
  172. 402 CONTINUE
  173. 400 CONTINUE
  174.  
  175. 1000 CONTINUE
  176.  
  177. IF (IPVECT.EQ.0) THEN
  178. IF (MELVA1.NE.0) SEGDES,MELVA1
  179. IF (MELVA2.NE.0) SEGDES,MELVA2
  180. IF (MELVA3.NE.0) SEGDES,MELVA3
  181. ENDIF
  182. C* SEGDES,MELEME (<- actif en E/S et non modifie)
  183.  
  184. RETURN
  185. END
  186.  
  187.  
  188.  

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