Télécharger fsma2d.eso

Retour à la liste

Numérotation des lignes :

  1. C FSMA2D SOURCE FANDEUR 12/07/18 21:15:40 7434
  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. SEGACT,MELVA1
  56. IGM1 = MELVA1.VELCHE(/1)
  57. IBM1 = MELVA1.VELCHE(/2)
  58. ENDIF
  59. IF (MELVA2.NE.0) THEN
  60. SEGACT,MELVA2
  61. IGM2 = MELVA2.VELCHE(/1)
  62. IBM2 = MELVA2.VELCHE(/2)
  63. ENDIF
  64. V1 = XZero
  65. V2 = XZero
  66. ELSE
  67. V1 = VEC(1)
  68. V2 = VEC(2)
  69. ENDIF
  70. C
  71. MINTE=IPTINT
  72. C* SEGACT MINTE <- ACTIF EN E/S (NON MODIFIE)
  73. NBPGAU=POIGAU(/1)
  74. C
  75. MELEME=IPMAIL
  76. C* SEGACT,MELEME <- ACTIF EN E/S (NON MODIFIE)
  77. NBNN =NUM(/1)
  78. NBELEM=NUM(/2)
  79. C
  80. SEGINI,WORK
  81. C
  82. C RECUPERATION DE L'EPAISSEUR (CONTRAINTES PLANES) :
  83. C
  84. DIM3 = 1.D0
  85. MELVA6 = 0
  86. IF (IFOUR.EQ.-2) THEN
  87. IF (IVACAR.NE.0) THEN
  88. MPTVAL = IVACAR
  89. MELVA6 = IVAL(1)
  90. IF (MELVA6.NE.0) THEN
  91. IGEP = MELVA6.VELCHE(/1)
  92. IBEP = MELVA6.VELCHE(/2)
  93. ENDIF
  94. ENDIF
  95. ENDIF
  96. C
  97. C BOUCLE SUR LES ELEMENTS
  98. C
  99. DO 1 IB=1,NBELEM
  100. C
  101. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  102. C
  103. IF (MELVA6.NE.0) IBME = MIN(IB,IBEP)
  104. IF (IPVECT.EQ.0) THEN
  105. IF (MELVA1.NE.0) IB1 = MIN(IB,IBM1)
  106. IF (MELVA2.NE.0) IB2 = MIN(IB,IBM2)
  107. ENDIF
  108. C
  109. C BOUCLE SUR LES POINTS DE GAUSS
  110. C
  111. DO 10 IGAU=1,NBPGAU
  112. C
  113. C RECUPERATION DE L'EPAISSEUR
  114. C
  115. IF (MELVA6.NE.0) THEN
  116. IGMN = MIN(IGAU,IGEP)
  117. DIM3 = MELVA6.VELCHE(IGMN,IBME)
  118. ENDIF
  119. C
  120. VNQSI1=0.D0
  121. VNQSI2=0.D0
  122. DO 20 I=1,NBNN
  123. VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  124. VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  125. 20 CONTINUE
  126. ZN = SQRT(VNQSI1*VNQSI1 + VNQSI2*VNQSI2)
  127. X = VNQSI1 / ZN
  128. Y = VNQSI2 / ZN
  129.  
  130. IF (IFOUR.LT.0) THEN
  131. IF (IFOUR.EQ.-2) THEN
  132. R = DIM3
  133. ELSE
  134. R = 1.D0
  135. ENDIF
  136. ELSE
  137. R=0.D0
  138. DO 21 I=1,NBNN
  139. R = R + SHPTOT(1,I,IGAU)*XE(1,I)
  140. 21 CONTINUE
  141. IF (IFOUR.EQ.0) THEN
  142. R = X2Pi*R
  143. C* ELSE IF (IFOUR.EQ.1) THEN
  144. ELSE
  145. IF (NIFOUR.EQ.0) THEN
  146. R = X2Pi*R
  147. ELSE
  148. R = XPI*R
  149. ENDIF
  150. ENDIF
  151. ENDIF
  152. WGPGAU = POIGAU(IGAU)*R
  153. *
  154. IF (IPVECT.EQ.0) THEN
  155. IF (MELVA1.NE.0) THEN
  156. IGMN = MIN(IGAU,IGM1)
  157. V1 = MELVA1.VELCHE(IGMN,IB1)
  158. ENDIF
  159. IF (MELVA2.NE.0) THEN
  160. IGMN = MIN(IGAU,IGM2)
  161. V2 = MELVA2.VELCHE(IGMN,IB2)
  162. ENDIF
  163. ENDIF
  164.  
  165. * changement de repere du vecteur force
  166. VECT = X*V1 + Y*V2
  167. VECN = X*V2 - Y*V1
  168. T1 = WGPGAU * ( VNQSI1*VECT - VNQSI2*VECN )
  169. T2 = WGPGAU * ( VNQSI1*VECN + VNQSI2*VECT )
  170. C
  171. MPTVAL = IVAFOR
  172. DO 30 J = 1, NBNN
  173. MELVAL=IVAL(1)
  174. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1
  175. MELVAL=IVAL(2)
  176. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2
  177. 30 CONTINUE
  178. C
  179. 10 CONTINUE
  180.  
  181. 1 CONTINUE
  182.  
  183. C* SEGDES,MELEME <- ACTIF EN E/S (NON MODIFIE)
  184. C* SEGDES MINTE <- ACTIF EN E/S (NON MODIFIE)
  185. SEGSUP,WORK
  186. IF (IPVECT.EQ.0) THEN
  187. IF (MELVA1.NE.0) SEGDES,MELVA1
  188. IF (MELVA2.NE.0) SEGDES,MELVA2
  189. ENDIF
  190.  
  191. RETURN
  192. END
  193.  
  194.  
  195.  

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