Numérotation des lignes :

ense
1. C ENSE SOURCE PV 22/03/15 21:15:04 11315
2. SUBROUTINE ENSE
3. IMPLICIT INTEGER(I-N)
4. IMPLICIT REAL*8(A-H,O-Z)
5. -INC SMCHPOI
6. -INC SMELEME
7.
8. -INC PPARAM
9. -INC CCOPTIO
10. -INC SMRIGID
11. -INC SMMATRI
12. -INC SMSOLUT
13. SEGMENT ITRAV(NENS)
14. integer insym
15. insym = 0
16. C
17. CALL LIROBJ ('RIGIDITE',MRIGID,1,IRETOU)
18. IF(IERR.NE.0) RETURN
19. SEGACT MRIGID
20. *
21. * ON TESTE SI IL Y A DES RIGIDITES UNILATERALES
22. *
23. DO 4 I=1,IRIGEL(/2)
24. IF(IRIGEL(6,I).NE.0) THEN
25. CALL ERREUR(433)
26. SEGDES MRIGID
27. RETURN
28. ENDIF
29. 4 CONTINUE
30. *
31. IIFO=IFORIG
32. C
33. NRG = IRIGEL(/1)
34. NBR = IRIGEL(/2)
35. IF(NORINC.GT.0 .AND. NORIND.GT.0) THEN
36. INSYM = 1
37. ENDIF
38. IF (NRG.GE.7) THEN
39. DO 9 IN = 1,NBR
40. IANTI=IRIGEL(7,IN)
41. IF(IANTI.GT.0) THEN
42. INSYM = 1
43. ENDIF
44. 9 CONTINUE
45. ENDIF
46. CALL ECROBJ ('RIGIDITE',MRIGID)
47. CALL RESOU
48. IF (IERR.NE.0) RETURN
49. SEGACT,MRIGID
50. MRISAU=MRIGID
51. 300 continue
52. IF (JRCOND.NE.0) THEN
53. MRIGID=JRCOND
54. SEGACT MRIGID
55. ENDIF
56. if(ichole.eq.0.and.jrcond.ne.0) goto 300
57. MMATRI=ICHOLE
58. SEGACT MMATRI
59. IF(NENS.EQ.0) THEN
60. SEGDES MMATRI
61. CALL ERREUR(327)
62. RETURN
63. ENDIF
64. MRIGID=MRISAU
65. C
66. C ON MET DANS ITRAV LE NUMERO DES LIGNES OU LES MVTS D'ENSEMBLES
67. C ONT ETE DETECTES
68. C
69. MILIGN=IILIGN
70. SEGACT MILIGN
71. SEGINI ITRAV
72. DO 1 I=ILIGN(/1),1,-1
73. LIGN=ILIGN(I)
74. SEGACT LIGN
75. DO 1501 IIJ=IMMM(/1),1,-1
76. IN=IMMM(IIJ)
77. IF(IN.EQ.0) GO TO 1501
78. ITRAV(IN)=IIJ +IPREL-1
79. IF(IN.EQ.1) GO TO 2
80. 1501 CONTINUE
81. SEGDES LIGN
82. 1 CONTINUE
83. C
84. C ON N'A PAS TROUVER LE NOMBRE DE MODE D'ENSEMBLE VOULU
85. C
86. CALL ERREUR (5)
87. SEGSUP ITRAV
88. SEGDES MMATRI,MILIGN
89. RETURN
90. 2 CONTINUE
91. C
92. C FABRICATION DES CHPOINT SECOND MEMBRE BOUCLE 10
93. C
94. IPT1=IGEOMA
95. MINCPO=IINCPO
96. MIDUA=IIDUA
97. MHARK=IHARK
98. MDIAG=IDIAG
99. SEGACT MINCPO,MIDUA,MHARK,IPT1,MDIAG
100. NSOUPO=1
101. NC=1
102. N=1
103. NBNN=1
104. NBELEM=1
105. NBREF=0
106. NBSOUS=0
107. NAT=1
108. DO 10 I=1,NENS
109. SEGINI MCHPOI
110. IFOPOI=IIFO
111. C les modes solutions sont des chpo de type diffus
112. JATTRI(1)=2
113. SEGINI MSOUPO
114. IPCHP(1)=MSOUPO
115. SEGINI MELEME
116. IGEOC=MELEME
117. ITYPEL=1
118. C
119. C RECHERCHE DU NUMERO DU NOEUD ET DU NOM DE L'INCONNUES PAR
120. C L'INTERMEDIAIRE DU TABLEAU INCPO
121. C
122. IA=ITRAV(I)
123. DO J=INCPO(/2),1,-1
124. j1=J
125. DO K=1,INCPO(/1)
126. k1= K
127. IF(INCPO(K,J).EQ.IA) GO TO 12
128. ENDDO
129. ENDDO
130. C
131. C ERREUR PAS NORMALE
132. C
133. CALL ERREUR(5)
134. RETURN
135. 12 CONTINUE
136. NUM(1,1)=IPT1.NUM(1,J1)
137. NOCOMP(1)=IDUA(K1)
138. NOHARM(1)=IHAR(K1)
139. SEGINI MPOVAL
140. IPOVAL=MPOVAL
141. VPOCHA(1,1)=DIAG(IA)
142. SEGDES MPOVAL,MELEME,MSOUPO,MCHPOI
143. ITRAV(I)=MCHPOI
144. 10 CONTINUE
145. C
146. C ON VA APPELE RESOU
147. C
148. SEGDES MINCPO,MIDUA,MHARK,IPT1,MDIAG
149. SEGDES MMATRI,MRIGID,MILIGN
150. DO 20 I=1,ITRAV(/1)
151. ITRA=ITRAV(I)
152. CALL ECROBJ ('CHPOINT ',ITRA)
153. 20 CONTINUE
154. CALL ECROBJ ('RIGIDITE',MRIGID)
155. CALL ECRCHA ('ENSE')
156. CALL RESOU
157. * resou sort le nombre de modes d'ensemble
158. CALL LIRENT(I,1,iretou)
159. * et le maillage des noeuds contraints
160. call lirobj('MAILLAGE',ipt8,1,iretou)
161. IF(IERR.NE.0) RETURN
162. DO 21 I=1,ITRAV(/1)
163. CALL LIROBJ('CHPOINT ',ICHP,1,IRETOU)
164. IF(IERR.NE.0) THEN
165. CALL ERREUR(5)
166. RETURN
167. ENDIF
168. MCHPOI=ITRAV(I)
169. SEGACT MCHPOI
170. MSOUPO=IPCHP(1)
171. SEGACT MSOUPO
172. MELEME=IGEOC
173. MPOVAL=IPOVAL
174. SEGSUP MPOVAL,MELEME
175. SEGSUP MSOUPO
176. SEGSUP MCHPOI
177. ITRAV(I)=ICHP
178. 21 CONTINUE
179. C
180. C ON ORTHOGONALISE LES VECTEURS LES UNS PAR RAPPORT AUX AUTRES
181. C
182. DO 40 I=1,ITRAV(/1)
183. MCHPOI=ITRAV(I)
184. C
185. C ON CALCULE LES PRODUIT XJ * XI AVEC J &lt; I PUIS ON FAIT
186. C XI = XI - (XJ*XI) XJ
187. C
188. SEGACT MCHPOI
189. DO 39 J = 1,IPCHP(/1)
190. MSOUPO=IPCHP(J)
191. SEGACT MSOUPO
192. MPOVAL=IPOVAL
193. SEGACT MPOVAL*MOD
194. 39 CONTINUE
195. IF(I.EQ.1) GO TO 47
196. I1= I -1
197. DO 41 J = 1,I1
198. MCHPO1=ITRAV(J)
199. SEGACT MCHPO1
200. AA=0.D0
201. NSOUPO=IPCHP(/1)
202. DO 42 K=1,NSOUPO
203. MSOUPO=IPCHP(K)
204. MSOUP1=MCHPO1.IPCHP(K)
205. SEGACT MSOUP1
206. MPOVAL=IPOVAL
207. MPOVA1=MSOUP1.IPOVAL
208. SEGACT MPOVA1
209. DO L=1,VPOCHA(/2)
210. DO M=1,VPOCHA(/1)
211. AA=AA+VPOCHA(M,L)*MPOVA1.VPOCHA(M,L)
212. ENDDO
213. ENDDO
214. 42 CONTINUE
215. DO 44 K=1,NSOUPO
216. MSOUPO=IPCHP(K)
217. MPOVAL=IPOVAL
218. MSOUP1=MCHPO1.IPCHP(K)
219. MPOVA1=MSOUP1.IPOVAL
220. DO L=1,VPOCHA(/2)
221. DO M=1,VPOCHA(/1)
222. VPOCHA(M,L)=VPOCHA(M,L)- AA * MPOVA1.VPOCHA(M,L)
223. ENDDO
224. ENDDO
225. 44 CONTINUE
226. SEGDES MPOVA1,MSOUP1,MCHPO1
227. 41 CONTINUE
228. 47 CONTINUE
229. C
230. C ON NORME LE VECTEUR TROUVE
231. C
232. BB=0.D0
233. DO 50 J = 1, IPCHP(/1)
234. MSOUPO=IPCHP(J)
235. MPOVAL=IPOVAL
236. DO K=1,VPOCHA(/2)
237. DO L=1,VPOCHA(/1)
238. BB = BB + VPOCHA(L,K)*VPOCHA(L,K)
239. ENDDO
240. ENDDO
241. 50 CONTINUE
242. IF( BB . EQ.0.D0 ) THEN
243. CALL ERREUR(5)
244. RETURN
245. ENDIF
246. CC = 1.D0/(SQRT(BB))
247. DO 52 J = 1, IPCHP(/1)
248. MSOUPO=IPCHP(J)
249. MPOVAL=IPOVAL
250. DO K=1,VPOCHA(/2)
251. DO L=1,VPOCHA(/1)
252. VPOCHA(L,K)=VPOCHA(L,K)*CC
253. ENDDO
254. ENDDO
255. SEGDES MPOVAL,MSOUPO
256. 52 CONTINUE
257. SEGDES MCHPOI
258. 40 CONTINUE
259. C
260. C ON CREE UN OBJET SOLUT PAR MODE ET ON FUSIONNE
261. C
262. DO 30 IIM=1,ITRAV(/1)
263. IPCH=ITRAV(IIM)
264. LVALM=5
265. NIMOD=3
266. NIPO=5
267. SEGINI MSOLUT
268. SEGINI MMODE
269. MSOLIS(4)=MMODE
270. MSOLIS(5)=IPCH
271. IMMODD(1)=IIM
272. MCHPOI=MSOLIS(5)
273. SEGACT MCHPOI
274. IF(IFOPOI.NE.1) GOTO 101
275. ICHPOI=MCHPOI
276. CALL NUHARM(ICHPOI,IFO,IHARM)
277. MCHPOI=ICHPOI
278. IF(IFO.NE.1) THEN
279. IMMODD(2)=0
280. IMMODD(3)=0
281. ELSE
282. IMMODD(2)=IHARM
283. IF(IHARM.LT.0)IMMODD(3)=1
284. IF(IHARM.GE.0)IMMODD(3)=2
285. ENDIF
286. 101 CONTINUE
287. SEGDES MCHPOI
288. SEGDES MMODE
289. ITYSOL='MODE '
290. C
291. C
292. C **** ON CREE LE NOEUD NBNO+1 QUI VA ETRE ASSOCIE AU MODE.
293. C **** ON MET CE NOEUD A L ORIGINE. IL VA SERVIR D INDICE AU MODE
294. C
295. ZERO=0.D0
296. CALL CREPO1(ZERO,ZERO,ZERO,IPOIN)
297. NBSOUS=0
298. NBREF=0
299. NBNN=1
300. NBELEM=1
301. SEGINI MELEME
302. NUM(1,1)=IPOIN
303. ITYPEL=1
304. SEGDES MELEME
305. MSOLIS(3)=MELEME
306. C
307. N=1
308. DO 1100 I=4,NIPO
309. IF(MSOLIS(I).EQ.0)GOTO 1100
310. SEGINI MSOLEN
311. ISOLEN(1)=MSOLIS(I)
312. SEGDES MSOLEN
313. MSOLIS(I)=MSOLEN
314. GOTO (1100,1100,1100,1100,1101,1102,1102,1101,1101,1100),I
315. 1101 CONTINUE
316. MSOLIT(I)=2
317. GOTO1100
318. 1102 CONTINUE
319. MSOLIT(I)=5
320. 1100 CONTINUE
321. SEGDES MSOLUT
322. C
323. IF(IIM.EQ.1) THEN
324. MSOL1=MSOLUT
325. ELSE
326. CALL FUSOLU(MSOL1,MSOLUT,MSOL2)
327. MSOL1=MSOL2
328. ENDIF
329. 30 CONTINUE
330. CALL ECROBJ('SOLUTION',MSOL1)
331. RETURN
332. END
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.

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