Télécharger fsma3d.eso

Retour à la liste

Numérotation des lignes :

  1. C FSMA3D SOURCE FANDEUR 12/07/18 21:15:41 7434
  2.  
  3. SUBROUTINE FSMA3D(IPT,IPMAIL,IPTINT,IPVECT,VEC,IVAFOR)
  4. C
  5. C____________________________________________________________________
  6. C
  7. C CALCULE LES FORCES SURFACIQUES SUR LES FACES D ELEMENTS
  8. C MASSIFS TRIDIMENSIONNELS
  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 POINTEUR SUR UN OBJET GEOMETRIQUE
  17. C IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION
  18. C IPVECT POINTEUR SUR LE VECTEUR REPRESENTANT LA FORCE
  19. C VEC VECTEUR REPRESENTANT LA FORCE
  20. C IVAFOR POINTEUR SUR UN MPTVAL ET LES MELVAL CONTENANT LES FORCES
  21. C NODALES RESUL
  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.  
  30. -INC SMCHAML
  31. -INC SMELEME
  32. -INC SMINTE
  33. -INC SMCOORD
  34. C
  35. SEGMENT MPTVAL
  36. INTEGER IPOS(NS) ,NSOF(NS)
  37. INTEGER IVAL(NCOSOU)
  38. CHARACTER*16 TYVAL(NCOSOU)
  39. ENDSEGMENT
  40. C
  41. SEGMENT WORK
  42. REAL*8 XE(3,NBNN)
  43. ENDSEGMENT
  44. C
  45. DIMENSION VEC(*),IPT(*)
  46. C
  47. MELVA1 = IPT(1)
  48. MELVA2 = IPT(2)
  49. MELVA3 = IPT(3)
  50. IF (IPVECT.EQ.0) THEN
  51. IF (MELVA1.NE.0) THEN
  52. SEGACT,MELVA1
  53. IGM1 = MELVA1.VELCHE(/1)
  54. IBM1 = MELVA1.VELCHE(/2)
  55. ENDIF
  56. IF (MELVA2.NE.0) THEN
  57. SEGACT,MELVA2
  58. IGM2 = MELVA2.VELCHE(/1)
  59. IBM2 = MELVA2.VELCHE(/2)
  60. ENDIF
  61. IF (MELVA3.NE.0) THEN
  62. SEGACT,MELVA3
  63. IGM3 = MELVA3.VELCHE(/1)
  64. IBM3 = MELVA3.VELCHE(/2)
  65. ENDIF
  66. AUX1 = 0.D0
  67. AUX2 = 0.D0
  68. AUX3 = 0.D0
  69. ELSE
  70. AUX1 = VEC(1)
  71. AUX2 = VEC(2)
  72. AUX3 = VEC(3)
  73. ENDIF
  74. C
  75. MINTE=IPTINT
  76. C* SEGACT,MINTE <- ACTIF EN E/S (NON MODIFIE)
  77. NBPGAU=POIGAU(/1)
  78. C
  79. MELEME=IPMAIL
  80. C* SEGACT,MELEME <- ACTIF EN E/S (NON MODIFIE)
  81. NBNN =NUM(/1)
  82. NBELEM=NUM(/2)
  83. C
  84. SEGINI,WORK
  85. C
  86. C BOUCLE SUR LES ELEMENTS
  87. C
  88. DO 1 IB = 1, NBELEM
  89. C
  90. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  91.  
  92. IF (IPVECT.EQ.0) THEN
  93. IF (MELVA1.NE.0) IB1 = MIN(IB,IBM1)
  94. IF (MELVA2.NE.0) IB2 = MIN(IB,IBM2)
  95. IF (MELVA3.NE.0) IB3 = MIN(IB,IBM3)
  96. ENDIF
  97. C
  98. C BOUCLE SUR LES POINTS DE GAUSS
  99. C
  100. DO 10 IGAU=1,NBPGAU
  101. C
  102. C
  103. C BOUCLE SUR LES NOEUDS
  104. C
  105. VNQSI1 = 0.D0
  106. VNQSI2 = 0.D0
  107. VNQSI3 = 0.D0
  108. VNETA1 = 0.D0
  109. VNETA2 = 0.D0
  110. VNETA3 = 0.D0
  111. DO 20 I = 1,NBNN
  112. VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  113. VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  114. VNQSI3=VNQSI3+SHPTOT(2,I,IGAU)*XE(3,I)
  115. VNETA1=VNETA1+SHPTOT(3,I,IGAU)*XE(1,I)
  116. VNETA2=VNETA2+SHPTOT(3,I,IGAU)*XE(2,I)
  117. VNETA3=VNETA3+SHPTOT(3,I,IGAU)*XE(3,I)
  118. 20 CONTINUE
  119. VNOR1 = VNQSI2*VNETA3-VNQSI3*VNETA2
  120. VNOR2 = VNQSI3*VNETA1-VNQSI1*VNETA3
  121. VNOR3 = VNQSI1*VNETA2-VNQSI2*VNETA1
  122. r_z = POIGAU(IGAU) * SQRT(VNOR1*VNOR1+VNOR2*VNOR2+VNOR3*VNOR3)
  123. C
  124. IF (IPVECT.EQ.0) THEN
  125. IF (MELVA1.NE.0) THEN
  126. IGMN = MIN(IGAU,IGM1)
  127. AUX1 = MELVA1.VELCHE(IGMN,IB1)
  128. ENDIF
  129. IF (MELVA2.NE.0) THEN
  130. IGMN = MIN(IGAU,IGM2)
  131. AUX2 = MELVA2.VELCHE(IGMN,IB2)
  132. ENDIF
  133. IF (MELVA3.NE.0) THEN
  134. IGMN = MIN(IGAU,IGM3)
  135. AUX3 = MELVA3.VELCHE(IGMN,IB3)
  136. ENDIF
  137. ENDIF
  138. *
  139. T1 = r_z * AUX1
  140. T2 = r_z * AUX2
  141. T3 = r_z * AUX3
  142. C
  143. MPTVAL=IVAFOR
  144. DO 30 J=1,NBNN
  145. r_z = SHPTOT(1,J,IGAU)
  146. MELVAL = IVAL(1)
  147. VELCHE(J,IB) = VELCHE(J,IB) + r_z * T1
  148. MELVAL = IVAL(2)
  149. VELCHE(J,IB) = VELCHE(J,IB) + r_z * T2
  150. MELVAL = IVAL(3)
  151. VELCHE(J,IB) = VELCHE(J,IB) + r_z * T3
  152. 30 CONTINUE
  153.  
  154. 10 CONTINUE
  155.  
  156. 1 CONTINUE
  157.  
  158. SEGSUP WORK
  159.  
  160. IF (IPVECT.EQ.0) THEN
  161. IF (MELVA1.NE.0) SEGDES,MELVA1
  162. IF (MELVA2.NE.0) SEGDES,MELVA2
  163. IF (MELVA3.NE.0) SEGDES,MELVA3
  164. ENDIF
  165. C* SEGDES,MELEME <- ACTIF EN E/S (NON MODIFIE)
  166. C* SEGDES,MINTE <- ACTIF EN E/S (NON MODIFIE)
  167.  
  168. RETURN
  169. END
  170.  
  171.  
  172.  

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