Télécharger fsma2d.eso

Retour à la liste

Numérotation des lignes :

fsma2d
  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.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC CCREEL
  32.  
  33. -INC SMCHAML
  34. -INC SMELEME
  35. -INC SMINTE
  36. -INC SMCOORD
  37. C
  38. SEGMENT WORK
  39. REAL*8 XE(3,NBNN)
  40. ENDSEGMENT
  41. C
  42. SEGMENT MPTVAL
  43. INTEGER IPOS(NS) ,NSOF(NS)
  44. INTEGER IVAL(NCOSOU)
  45. CHARACTER*16 TYVAL(NCOSOU)
  46. ENDSEGMENT
  47. C
  48. DIMENSION VEC(*),IPT(*)
  49. C
  50. C= Quelques constantes (2.Pi)
  51. PARAMETER (X2Pi=6.283185307179586476925286766559D0)
  52. C
  53. MELVA1 = IPT(1)
  54. MELVA2 = IPT(2)
  55. IF (IPVECT.EQ.0) THEN
  56. IF (MELVA1.NE.0) THEN
  57. IGM1 = MELVA1.VELCHE(/1)
  58. IBM1 = MELVA1.VELCHE(/2)
  59. ENDIF
  60. IF (MELVA2.NE.0) THEN
  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. NBPGAU=POIGAU(/1)
  73. C
  74. MELEME=IPMAIL
  75. NBNN =NUM(/1)
  76. NBELEM=NUM(/2)
  77. C
  78. SEGINI,WORK
  79. C
  80. C RECUPERATION DE L'EPAISSEUR (CONTRAINTES PLANES) :
  81. C
  82. DIM3 = 1.D0
  83. MELVA6 = 0
  84. IF (IFOUR.EQ.-2) THEN
  85. IF (IVACAR.NE.0) THEN
  86. MPTVAL = IVACAR
  87. MELVA6 = IVAL(1)
  88. IF (MELVA6.NE.0) THEN
  89. IGEP = MELVA6.VELCHE(/1)
  90. IBEP = MELVA6.VELCHE(/2)
  91. ENDIF
  92. ENDIF
  93. ENDIF
  94. C
  95. C BOUCLE SUR LES ELEMENTS
  96. C
  97. DO 1 IB=1,NBELEM
  98. C
  99. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  100. C
  101. IF (MELVA6.NE.0) IBME = MIN(IB,IBEP)
  102. IF (IPVECT.EQ.0) THEN
  103. IF (MELVA1.NE.0) IB1 = MIN(IB,IBM1)
  104. IF (MELVA2.NE.0) IB2 = MIN(IB,IBM2)
  105. ENDIF
  106. C
  107. C BOUCLE SUR LES POINTS DE GAUSS
  108. C
  109. DO 10 IGAU=1,NBPGAU
  110. C
  111. C RECUPERATION DE L'EPAISSEUR
  112. C
  113. IF (MELVA6.NE.0) THEN
  114. IGMN = MIN(IGAU,IGEP)
  115. DIM3 = MELVA6.VELCHE(IGMN,IBME)
  116. ENDIF
  117. C
  118. VNQSI1=0.D0
  119. VNQSI2=0.D0
  120. DO 20 I=1,NBNN
  121. VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  122. VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  123. 20 CONTINUE
  124. ZN = SQRT(VNQSI1*VNQSI1 + VNQSI2*VNQSI2)
  125. X = VNQSI1 / ZN
  126. Y = VNQSI2 / ZN
  127.  
  128. IF (IFOUR.LT.0) THEN
  129. IF (IFOUR.EQ.-2) THEN
  130. R = DIM3
  131. ELSE
  132. R = 1.D0
  133. ENDIF
  134. ELSE
  135. R=0.D0
  136. DO 21 I=1,NBNN
  137. R = R + SHPTOT(1,I,IGAU)*XE(1,I)
  138. 21 CONTINUE
  139. IF (IFOUR.EQ.0) THEN
  140. R = X2Pi*R
  141. C* ELSE IF (IFOUR.EQ.1) THEN
  142. ELSE
  143. IF (NIFOUR.EQ.0) THEN
  144. R = X2Pi*R
  145. ELSE
  146. R = XPI*R
  147. ENDIF
  148. ENDIF
  149. ENDIF
  150. WGPGAU = POIGAU(IGAU)*R
  151. *
  152. IF (IPVECT.EQ.0) THEN
  153. IF (MELVA1.NE.0) THEN
  154. IGMN = MIN(IGAU,IGM1)
  155. V1 = MELVA1.VELCHE(IGMN,IB1)
  156. ENDIF
  157. IF (MELVA2.NE.0) THEN
  158. IGMN = MIN(IGAU,IGM2)
  159. V2 = MELVA2.VELCHE(IGMN,IB2)
  160. ENDIF
  161. ENDIF
  162.  
  163. * changement de repere du vecteur force
  164. VECT = X*V1 + Y*V2
  165. VECN = X*V2 - Y*V1
  166. T1 = WGPGAU * ( VNQSI1*VECT - VNQSI2*VECN )
  167. T2 = WGPGAU * ( VNQSI1*VECN + VNQSI2*VECT )
  168. C
  169. MPTVAL = IVAFOR
  170. DO 30 J = 1, NBNN
  171. MELVAL=IVAL(1)
  172. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1
  173. MELVAL=IVAL(2)
  174. VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2
  175. 30 CONTINUE
  176. C
  177. 10 CONTINUE
  178.  
  179. 1 CONTINUE
  180.  
  181. SEGSUP,WORK
  182. END
  183.  
  184.  
  185.  

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