Télécharger fsma2d.eso

Retour à la liste

Numérotation des lignes :

  1. C FSMA2D SOURCE CB215821 19/07/30 21:16:34 10273
  2.  
  3. SUBROUTINE FSMA2D(IPT,IPMAIL,IPTINT,IPVECT,VEC,IVAFOR,IVACAR)
  4. C
  5. C____________________________________________________________________
  6. C CALCULE LES FORCES SURFACIQUES SUR LES FACES D ELEMENTS
  7. C MASSIFS BIDIMENSIONNELS
  8. C
  9. C ENTREES :
  10. C ---------
  11. C
  12. C IPT TABLEAU DE POINTEUR SUR UN MELVAL CONTENANT LES FORCES
  13. C APPLIQUEES
  14. C 0 SI ON A DONNE UN VECTEUR CONSTANT
  15. C IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE
  16. C IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION
  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 LES MELVALS CONTENANT LES FORCES
  20. C NODALES RESULTANTES
  21. C IVACAR POINTEUR SUR UN MELVAL DE CARACTERISTIQUES
  22. C
  23. C____________________________________________________________________
  24. C
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8(A-H,O-Z)
  27. C
  28. -INC CCOPTIO
  29. -INC CCREEL
  30.  
  31. -INC SMCHAML
  32. -INC SMELEME
  33. -INC SMINTE
  34. -INC SMCOORD
  35. C
  36. SEGMENT WORK
  37. REAL*8 XE(3,NBNN)
  38. ENDSEGMENT
  39. C
  40. SEGMENT MPTVAL
  41. INTEGER IPOS(NS) ,NSOF(NS)
  42. INTEGER IVAL(NCOSOU)
  43. CHARACTER*16 TYVAL(NCOSOU)
  44. ENDSEGMENT
  45. C
  46. DIMENSION VEC(*),IPT(*)
  47. C
  48. C= Quelques constantes (2.Pi)
  49. PARAMETER (X2Pi=6.283185307179586476925286766559D0)
  50. C
  51. MELVA1 = IPT(1)
  52. MELVA2 = IPT(2)
  53. IF (IPVECT.EQ.0) THEN
  54. IF (MELVA1.NE.0) THEN
  55. IGM1 = MELVA1.VELCHE(/1)
  56. IBM1 = MELVA1.VELCHE(/2)
  57. ENDIF
  58. IF (MELVA2.NE.0) THEN
  59. IGM2 = MELVA2.VELCHE(/1)
  60. IBM2 = MELVA2.VELCHE(/2)
  61. ENDIF
  62. V1 = XZero
  63. V2 = XZero
  64. ELSE
  65. V1 = VEC(1)
  66. V2 = VEC(2)
  67. ENDIF
  68. C
  69. MINTE=IPTINT
  70. NBPGAU=POIGAU(/1)
  71. C
  72. MELEME=IPMAIL
  73. NBNN =NUM(/1)
  74. NBELEM=NUM(/2)
  75. C
  76. SEGINI,WORK
  77. C
  78. C RECUPERATION DE L'EPAISSEUR (CONTRAINTES PLANES) :
  79. C
  80. DIM3 = 1.D0
  81. MELVA6 = 0
  82. IF (IFOUR.EQ.-2) THEN
  83. IF (IVACAR.NE.0) THEN
  84. MPTVAL = IVACAR
  85. MELVA6 = IVAL(1)
  86. IF (MELVA6.NE.0) THEN
  87. IGEP = MELVA6.VELCHE(/1)
  88. IBEP = MELVA6.VELCHE(/2)
  89. ENDIF
  90. ENDIF
  91. ENDIF
  92. C
  93. C BOUCLE SUR LES ELEMENTS
  94. C
  95. DO 1 IB=1,NBELEM
  96. C
  97. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  98. C
  99. IF (MELVA6.NE.0) IBME = MIN(IB,IBEP)
  100. IF (IPVECT.EQ.0) THEN
  101. IF (MELVA1.NE.0) IB1 = MIN(IB,IBM1)
  102. IF (MELVA2.NE.0) IB2 = MIN(IB,IBM2)
  103. ENDIF
  104. C
  105. C BOUCLE SUR LES POINTS DE GAUSS
  106. C
  107. DO 10 IGAU=1,NBPGAU
  108. C
  109. C RECUPERATION DE L'EPAISSEUR
  110. C
  111. IF (MELVA6.NE.0) THEN
  112. IGMN = MIN(IGAU,IGEP)
  113. DIM3 = MELVA6.VELCHE(IGMN,IBME)
  114. ENDIF
  115. C
  116. VNQSI1=0.D0
  117. VNQSI2=0.D0
  118. DO 20 I=1,NBNN
  119. VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  120. VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  121. 20 CONTINUE
  122. ZN = SQRT(VNQSI1*VNQSI1 + VNQSI2*VNQSI2)
  123. X = VNQSI1 / ZN
  124. Y = VNQSI2 / ZN
  125.  
  126. IF (IFOUR.LT.0) THEN
  127. IF (IFOUR.EQ.-2) THEN
  128. R = DIM3
  129. ELSE
  130. R = 1.D0
  131. ENDIF
  132. ELSE
  133. R=0.D0
  134. DO 21 I=1,NBNN
  135. R = R + SHPTOT(1,I,IGAU)*XE(1,I)
  136. 21 CONTINUE
  137. IF (IFOUR.EQ.0) THEN
  138. R = X2Pi*R
  139. C* ELSE IF (IFOUR.EQ.1) THEN
  140. ELSE
  141. IF (NIFOUR.EQ.0) THEN
  142. R = X2Pi*R
  143. ELSE
  144. R = XPI*R
  145. ENDIF
  146. ENDIF
  147. ENDIF
  148. WGPGAU = POIGAU(IGAU)*R
  149. *
  150. IF (IPVECT.EQ.0) THEN
  151. IF (MELVA1.NE.0) THEN
  152. IGMN = MIN(IGAU,IGM1)
  153. V1 = MELVA1.VELCHE(IGMN,IB1)
  154. ENDIF
  155. IF (MELVA2.NE.0) THEN
  156. IGMN = MIN(IGAU,IGM2)
  157. V2 = MELVA2.VELCHE(IGMN,IB2)
  158. ENDIF
  159. ENDIF
  160.  
  161. * changement de repere du vecteur force
  162. VECT = X*V1 + Y*V2
  163. VECN = X*V2 - Y*V1
  164. T1 = WGPGAU * ( VNQSI1*VECT - VNQSI2*VECN )
  165. T2 = WGPGAU * ( VNQSI1*VECN + VNQSI2*VECT )
  166. C
  167. MPTVAL = IVAFOR
  168. DO 30 J = 1, NBNN
  169. MELVAL=IVAL(1)
  170. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1
  171. MELVAL=IVAL(2)
  172. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2
  173. 30 CONTINUE
  174. C
  175. 10 CONTINUE
  176.  
  177. 1 CONTINUE
  178.  
  179. SEGSUP,WORK
  180. END
  181.  
  182.  
  183.  

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