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 &lt;- ACTIF EN E/S (NON MODIFIE)
73. NBPGAU=POIGAU(/1)
74. C
75. MELEME=IPMAIL
76. C* SEGACT,MELEME &lt;- 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 &lt;- ACTIF EN E/S (NON MODIFIE)
184. C* SEGDES MINTE &lt;- 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