1 : C DEVFB3 SOURCE CHAT 05/01/12 22:45:25 5004
2 : SUBROUTINE DEVFB3(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
3 : & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
4 : & FEXPSM,NPC1,I,iannul)
5 : IMPLICIT INTEGER(I-N)
6 : IMPLICIT REAL*8(A-H,O-Z)
7 : *--------------------------------------------------------------------*
8 : * *
9 : * operateur dyne : algorithme de fu - de vogelaere *
10 : * ________________________________________________ *
11 : * *
12 : * calcul des forces de choc sur base b pour les liaisons *
13 : * de type point_cercle. *
14 : * *
15 : * param}tres: *
16 : * *
17 : * e ityp type de la liaison. *
18 : * es ftotb forces exterieures totalisees sur la base b. *
19 : * e xptb tableau des deplacements des points *
20 : * e ipalb renseigne sur la liaison. *
21 : * e iplib tableau contenant les numeros "dyne" de la liaison. *
22 : * e xpalb tableau contenant les parametres de la liaison. *
23 : * es xvalb tableau contenant les variables internes de liaisons. *
24 : * e nliab nombre de liaisons sur la base b. *
25 : * e nplb nombre total de points intervenant dans les liaisons. *
26 : * e ind indice du pas. *
27 : * e i num{ro de la liaison. *
28 : * *
29 : * *
30 : * auteur, date de creation: *
31 : * *
32 : * lionel vivan : le 22 septembre 1989 : creation *
33 : * bertrand beaufils : le 31 mai 1990 : ajout frottement sec*
34 : * I. Politopoulos : juin 1996 : ajout point_cercle_mobile *
35 : * *
36 : *--------------------------------------------------------------------*
37 : *
38 : -INC CCREEL
39 : INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
40 : REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*)
41 : REAL*8 XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*)
42 : REAL*8 XPTP2(3),XPTPM2(3),XFNT(3)
43 : REAL*8 XVPC0(3),XN2(3),XVPCT(3)
44 : *
45 : * --- choc elementaire point_cercle
46 : * avec ou sans amortissement
47 : *
48 : IF (ITYP.EQ.21 .OR. ITYP.EQ.22) THEN
49 : NPOI = IPLIB(I,1)
50 : IDIM = IPALB(I,3)
51 : XRAID = XPALB(I,1)
52 : XJEU = XPALB(I,2)
53 :
54 : IF (ITYP.EQ.21) THEN
55 : ID1 = 2
56 : ELSE
57 : XAMO = XPALB(I,3)
58 : ID1 = 3
59 : ENDIF
60 : ID2 = ID1 + IDIM
61 : PS = 0.D0
62 : DO 210 ID = 1,IDIM
63 : IDD1 = 3 + ID
64 : XVALB(I,IND,IDD1) = XPTB(NPOI,IND,ID)
65 : PS = PS + XPTB(NPOI,IND,ID) * XPALB(I,ID1+ID)
66 : 210 CONTINUE
67 : * end do
68 : XPME = 0.D0
69 : PSXPME = 0.D0
70 : DO 212 ID = 1,IDIM
71 : XPRIM = XPTB(NPOI,IND,ID) - PS * XPALB(I,ID1+ID)
72 : XPME = XPRIM - XPALB(I,ID2+ID)
73 : PSXPME = PSXPME + XPME * XPME
74 : 212 CONTINUE
75 : * end do
76 : XDEP = SQRT(PSXPME)
77 : IF (ITYP.EQ.21) THEN
77 : CALL DYCHE2(XDEP,XRAID,XJEU, XFL,iannul)
78 : ELSE
79 : XDEPM1 = 0.D0
80 : * IF (XDEP.GT.1D-20) THEN
81 : IF (XDEP.GT.xpetit) THEN
82 : PS2 = 0.D0
83 : * correction gayffier 4/04/96 xdepm1 mal calculé
84 : DO 213 ID=1,IDIM
85 : PS2 = PS2 + XPTB(NPOI,IND2,ID) * XPALB(I,ID1+ID)
86 : 213 CONTINUE
87 : DO 214 ID = 1,IDIM
88 : XPRIM = XPTB(NPOI,IND,ID) - PS * XPALB(I,ID1+ID)
89 : XPME = XPRIM - XPALB(I,ID2+ID)
90 : XNOR = XPME / XDEP
91 : XDEPM1 = XDEPM1 + (XPTB(NPOI,IND2,ID)
92 : & -PS2*XPALB(I,ID1+ID)-XPALB(I,ID2+ID))*XNOR
93 : 214 CONTINUE
94 : * end do
95 : ENDIF
96 : XVIT = (XDEP - XDEPM1) / PDTS2
97 : XVALB(I,IND,3) = XVIT
97 : CALL DYCHA2(XDEP,XVIT,XRAID,XJEU,XAMO, XFL,iannul)
98 : ENDIF
99 : XVALB(I,IND,1) = XFL
100 : * IF (XDEP.GE.XJEU .AND. XDEP.GT.1D-20) THEN
101 : IF (XDEP.GE.XJEU.AND.XDEP.GT.xpetit) THEN
102 : XPME = 0.D0
103 : DO 216 ID = 1,IDIM
104 : XPRIM = XPTB(NPOI,IND,ID) - PS * XPALB(I,ID1+ID)
105 : XPME = XPRIM - XPALB(I,ID2+ID)
106 : XNOR = XPME / XDEP
107 : FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFL * XNOR
108 : 216 CONTINUE
109 : * end do
110 : ENDIF
111 : *
112 : * --- choc elementaire point_cercle_frottement
113 : * avec ou sans amortissement
114 : *
115 : ELSE IF (ITYP.EQ.23 .OR. ITYP.EQ.24) THEN
116 : NPOI = IPLIB(I,1)
117 : IGP = IPALB(I,2)
118 : IDIM = IPALB(I,3)
119 : INTER = IPALB(I,4)
120 : IF (ITYP.EQ.23) THEN
121 : ID1 = 6
122 : ELSE
123 : ID1 = 7
124 : ENDIF
125 : ID2 = ID1 + IDIM
126 : ID3 = ID1 + 2*IDIM
127 : ID4 = ID1 + 3*IDIM
128 : ID5 = ID1 + 4*IDIM
129 : ID6 = ID1 + 5*IDIM
130 : ID7 = ID1 + 6*IDIM
131 : ID8 = ID1 + 7*IDIM
132 : ID9 = ID1 + 8*IDIM
133 : * si glissement au pas precedent, reactualisation de la position
134 : * origine d'adherence
135 : IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
136 : DO 230 ID=1,IDIM
137 : XPALB(I,ID7+ID) = XPTB(NPOI,IND,ID)
138 : 230 CONTINUE
139 : * end do
140 : ENDIF
141 : * calcul du deplacement sur la normale au plan de section droite
142 : PS = 0.D0
143 : DO 232 ID = 1,IDIM
144 : IDD2 = 3 + ID
145 : XVALB(I,IND,IDD2) = XPTB(NPOI,IND,ID)
146 : XPALB(I,ID4+ID) = XPTB(NPOI,IND,ID) - XPTB(NPOI,IND2,ID)
147 : XPALB(I,ID5+ID) = XPTB(NPOI,IND,ID) - XPALB(I,ID7+ID)
148 : PS = PS + XPTB(NPOI,IND,ID) * XPALB(I,ID1+ID)
149 : 232 CONTINUE
150 : * end do
151 : * calcul de la normale au plan tangent du contact, et de la valeur du
152 : * deplacement suivant cette normale
153 : XPME = 0.D0
154 : PSXPME = 0.D0
155 : DO 234 ID = 1,IDIM
156 : XPRIM = XPTB(NPOI,IND,ID) - PS * XPALB(I,ID1+ID)
157 : XPME = XPRIM - XPALB(I,ID2+ID)
158 : XPALB(I,ID3+ID) = XPME
159 : PSXPME = PSXPME + XPME * XPME
160 : 234 CONTINUE
161 : * end do
162 : XDEP = SQRT(PSXPME)
163 : * IF(XDEP.GT.1.D-20) THEN
164 : IF(XDEP.GT.xpetit) THEN
165 : DO 236 ID = 1,IDIM
166 : XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / XDEP
167 : 236 CONTINUE
168 : * end do
169 : ENDIF
170 : * calcul de la vitesse tangentielle par derivee a gauche
171 : PSN = 0.D0
172 : PSN0 = 0.D0
173 : DO 238 ID = 1,IDIM
174 : PSN = PSN + XPALB(I,ID4+ID) * XPALB(I,ID3+ID)
175 : PSN0 = PSN0 + XPALB(I,ID5+ID) * XPALB(I,ID3+ID)
176 : 238 CONTINUE
177 : * end do
178 : DO 240 ID = 1,IDIM
179 : XPALB(I,ID4+ID) = (XPALB(I,ID4+ID) -
180 : & PSN * XPALB(I,ID3+ID))/PDTS2
181 : XPALB(I,ID5+ID) = XPALB(I,ID5+ID) -
182 : & PSN0 * XPALB(I,ID3+ID)
183 : 240 CONTINUE
184 : * end do
185 : * calcul de la force de choc
186 : IF (ITYP.EQ.23) THEN
186 : CALL DYCHE3(XDEP,IDIM,IGP,XPALB,NLIAB,I,INTER,
187 : & XFN,XFT,XPUS,iannul)
188 : ELSE
189 : XVITN = PSN / PDTS2
190 : XVALB(I,IND,3) = XVITN
190 : CALL DYCHA3(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,INTER
191 : & ,XFN,XFT,XPUS,iannul)
192 : ENDIF
193 : XVALB(I,IND,1) = XFN
194 : XVALB(I,IND,10) = ABS(XFT)
195 : XVALB(I,IND,12) = XPUS
196 : IPALB(I,2) = IGP
197 :
198 : IF (IGP .EQ. 1) THEN
199 : PS = 0.D0
200 : DO 20 ID = 1,IDIM
201 : PS = PS + (XPALB(I,ID4+ID)*XPALB(I,ID4+ID))
202 : 20 CONTINUE
203 : XVITT = SQRT(PS)
204 : ELSE
205 : XVITT = 0.D0
206 : ENDIF
207 : XVALB(I,IND,11) = XVITT
208 : * si glissement, memorisation de la vitesse tangentielle et de la force
209 : * tangentielle
210 : IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
211 : DO 242 ID = 1,IDIM
212 : XPALB(I,ID8+ID) = XPALB(I,ID4+ID)
213 : XPALB(I,ID9+ID) = XPALB(I,ID6+ID)
214 : 242 CONTINUE
215 : * end do
216 : ENDIF
217 : DO 244 ID = 1,IDIM
218 : FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFN*XPALB(I,ID3+ID)
219 : & + XPALB(I,ID6+ID)
220 : 244 CONTINUE
221 :
222 : * --- choc elementaire point_cercle_mobile
223 : * avec ou sans amortissement
224 : * on neglige la rotation (torsion) du cercle
225 :
226 : ELSE IF (ITYP.EQ.33 .OR. ITYP.EQ.34) THEN
227 : NPOA = IPLIB(I,1)
228 : NPOB = IPLIB(I,2)
229 : IGP = IPALB(I,2)
230 : IDIM = IPALB(I,3)
231 : INTER = IPALB(I,4)
232 : IF (ITYP.EQ.33) THEN
233 : ID1 = 6
234 : ELSE
235 : ID1 = 7
236 : ENDIF
237 : ID2 = ID1 + IDIM
238 : ID3 = ID1 + 2*IDIM
239 : ID4 = ID1 + 3*IDIM
240 : ID5 = ID1 + 4*IDIM
241 : ID6 = ID1 + 5*IDIM
242 : ID7 = ID1 + 6*IDIM
243 : ID8 = ID1 + 7*IDIM
244 : ID9 = ID1 + 8*IDIM
245 : * si pas d'adherence (c.a.d. glissement ou pas de contact) au pas precedent,
246 : * reactualisation de la position ecart origine d'adherence
247 : IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
248 : DO 330 ID=1,IDIM
249 : XPALB(I,ID7+ID) = (XPTB(NPOA,IND,ID) +
250 : & FEXPSM(NPOA,NPA,IND1,ID) )
251 : & - ( XPTB(NPOB,IND,ID) +
252 : & FEXPSM(NPOB,NPA,IND1,ID))
253 : 330 CONTINUE
254 : * end do
255 : ENDIF
256 : * calcul du deplacement relatif (PS) sur la normale au plan de section droite
257 : PS = 0.D0
258 : DO 332 ID = 1,IDIM
259 : IDD2 = 3 + ID
260 : XDE2 = XPTB(NPOA,IND,ID) - XPTB(NPOB,IND,ID)
261 : XDE2 = XDE2 + FEXPSM(NPOa,NPA,IND1,ID)
262 : & - FEXPSM(NPOb,NPA,IND1,ID)
263 : XVALB(I,IND,IDD2) = XDE2
264 : XDM2 = XPTB(NPOA,IND2,ID) - xptb (npob,ind2,id)
265 : XDM2 = XDM2 + FEXPSM(NPOA,NPAM1,INDM1,ID)
266 : & - FEXPSM(NPOb,NPAM1,INDM1,ID)
267 : XPALB(I,ID4+ID) = XDE2 - XDM2
268 : XPALB(I,ID5+ID) = XDE2 - XPALB(I,ID7+ID)
269 : PS = PS + XDE2 * XPALB(I,ID1+ID)
270 : 332 CONTINUE
271 : * end do
272 :
273 : * calcul de la valeur du deplacement relatif suivant la normale
274 : * au plan tangent du contact (on tient compte de l'excentrement)
275 : XPME = 0.D0
276 : PSXPME = 0.D0
277 : DO 334 ID = 1,IDIM
278 : XDE2 = XPTB(NPOA,IND,ID) - XPTB(NPOB,IND,ID)
279 : XDE2 = XDE2 + FEXPSM(NPOa,NPA,IND1,ID)
280 : & - FEXPSM(NPOb,NPA,IND1,ID)
281 : XPRIM = XDE2 - PS * XPALB(I,ID1+ID)
282 : XPME = XPRIM - (XPALB(I,ID2+ID) -
283 : & XPALB(I,ID2+ID)*XPALB(I,ID1+ID))
284 : XPALB(I,ID3+ID) = XPME
285 : PSXPME = PSXPME + XPME * XPME
286 : 334 CONTINUE
287 : * end do
288 : XDEP = SQRT(PSXPME)
289 :
290 : * normale au plan tangent
291 : * IF(XDEP.GT.1.D-20) THEN
292 : IF(XDEP.GT.xpetit) THEN
293 : DO 336 ID = 1,IDIM
294 : XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / XDEP
295 : 336 CONTINUE
296 : * end do
297 : ENDIF
298 : * calcul de la vitesse relative tangentielle par derivee a gauche
299 : PSN = 0.D0
300 : PSN0 = 0.D0
301 : DO 338 ID = 1,IDIM
302 : PSN = PSN + XPALB(I,ID4+ID) * XPALB(I,ID3+ID)
303 : PSN0 = PSN0 + XPALB(I,ID5+ID) * XPALB(I,ID3+ID)
304 : 338 CONTINUE
305 : * end do
306 : DO 340 ID = 1,IDIM
307 : XPALB(I,ID4+ID) = (XPALB(I,ID4+ID) -
308 : & PSN * XPALB(I,ID3+ID))/PDTS2
309 : XPALB(I,ID5+ID) = XPALB(I,ID5+ID) -
310 : & PSN0 * XPALB(I,ID3+ID)
311 : 340 CONTINUE
312 : * end do
313 : * calcul de la force de choc
314 : IF (ITYP.EQ.33) THEN
314 : CALL DYCHE3(XDEP,IDIM,IGP,XPALB,NLIAB,I,INTER
315 : & ,XFN,XFT,XPUS,iannul)
316 : ELSE
317 : XVITN = PSN / PDTS2
318 : XVALB(I,IND,3) = XVITN
318 : CALL DYCHA3(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,INTER
319 : & ,XFN,XFT,XPUS,iannul)
320 : ENDIF
321 : XVALB(I,IND,1) = XFN
322 : XVALB(I,IND,10) = ABS(XFT)
323 : XVALB(I,IND,12) = XPUS
324 : IPALB(I,2) = IGP
325 :
326 : IF (IGP .EQ. 1) THEN
327 : PS = 0.D0
328 : DO 30 ID = 1,IDIM
329 : PS = PS + (XPALB(I,ID4+ID)*XPALB(I,ID4+ID))
330 : 30 CONTINUE
331 : XVITT = SQRT(PS)
332 : ELSE
333 : XVITT = 0.D0
334 : ENDIF
335 : XVALB(I,IND,11) = XVITT
336 : * si pas d'adherence (c.a.d. glissement ou pas de contact)
337 : * memorisation de la vitesse tangentielle et de la force tangentielle
338 : IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
339 : DO 342 ID = 1,IDIM
340 : XPALB(I,ID8+ID) = XPALB(I,ID4+ID)
341 : XPALB(I,ID9+ID) = XPALB(I,ID6+ID)
342 : 342 CONTINUE
343 : * end do
344 : ENDIF
345 :
346 : DO 344 ID = 1,IDIM
347 : FTOTB(NPOA,ID) = FTOTB(NPOA,ID) + XFN*XPALB(I,ID3+ID)
348 : & + XPALB(I,ID6+ID)
349 : FTOTB(NPOB,ID) = FTOTB(NPOB,ID) - XFN*XPALB(I,ID3+ID)
350 : & - XPALB(I,ID6+ID)
351 : 344 CONTINUE
352 :
353 : *
354 : * --- choc elementaire cercle_cercle_frottement
355 : * avec ou sans amortissement
356 : *
357 : ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN
358 : NPOI = IPLIB(I,1)
359 : IGP = IPALB(I,2)
360 : IDIM = IPALB(I,3)
361 : INTER = IPALB(I,4)
362 : IF (ITYP.EQ.25) THEN
363 : ID1 = 6
364 : ELSE
365 : ID1 = 7
366 : ENDIF
367 : ID2 = ID1 + IDIM
368 : ID3 = ID1 + 2*IDIM
369 : ID4 = ID1 + 3*IDIM
370 : ID5 = ID1 + 4*IDIM
371 : ID6 = ID1 + 5*IDIM
372 : ID7 = ID1 + 6*IDIM
373 : ID8 = ID1 + 7*IDIM
374 : ID9 = ID1 + 8*IDIM
375 : ID10 = ID1 + 9*IDIM
376 : XRAYT = XPALB(I,ID10+1)
377 : XREXT = XPALB(I,2)
378 : * calcul du deplacement du point fibre neutre dans le plan du cercle
379 : * recuperation de la normale de choc au pas precedent
380 : DO 249 ID = 1,IDIM
381 : XN2(ID)= XPALB(I,ID3+ID)
382 : 249 CONTINUE
383 : * calcul de la normale de choc au pas courant
384 : PSXPN = 0.D0
385 : DO 250 ID = 1,IDIM
386 : PSXPN = PSXPN + ( XPTB(NPOI,IND,ID) * XPALB(I,ID1+ID) )
387 : 250 CONTINUE
388 : * end do
389 : PSXPME = 0.D0
390 : DO 254 ID = 1,IDIM
391 : XXPME = ( XPTB(NPOI,IND,ID) - ( PSXPN * XPALB(I,ID1+ID) ) )
392 : & - XPALB(I,ID2+ID)
393 : XPALB(I,ID3+ID) = XXPME
394 : PSXPME = PSXPME + ( XXPME * XXPME )
395 : 254 CONTINUE
396 : * end do
397 : PSXPME = SQRT(PSXPME)
398 : * IF (PSXPME.GT.1D-20) THEN
399 : IF (PSXPME.GT.xpetit) THEN
400 : DO 256 ID = 1,IDIM
401 : XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / PSXPME
402 : 256 CONTINUE
403 : * end do
404 : ENDIF
405 : * valeur du deplacement du point de contact suivant la normale
406 : XDEP = PSXPME + XRAYT
407 : * calcul du deplacement du point de contact au pas courant
408 : XPTP2(1) = XPTB(NPOI,IND,1) + (XPALB(I,ID3+1)*XRAYT)
409 : XPTP2(2) = XPTB(NPOI,IND,2) + (XPALB(I,ID3+2)*XRAYT)
410 : XPTP2(3) = XPTB(NPOI,IND,3) + (XPALB(I,ID3+3)*XRAYT)
411 : * calcul du deplacement du point de contact au pas precedent
412 : XPTPM2(1) = XPTB(NPOI,IND2,1) + (XN2(1)*XRAYT)
413 : XPTPM2(2) = XPTB(NPOI,IND2,2) + (XN2(2)*XRAYT)
414 : XPTPM2(3) = XPTB(NPOI,IND2,3) + (XN2(3)*XRAYT)
415 : * Vitesse *(-1) du point de contact appartenant a la structure mobile
416 : * due a la rotation absolue
417 : XVPC0(1) = (1.D0/ PDTS2) *
418 : & ( ( XPTB(NPOI,IND2,5) * XPALB(I,ID3+3) * XRAYT ) -
419 : & ( XPTB(NPOI,IND2,6) * XPALB(I,ID3+2) * XRAYT ) -
420 : & ( XPTB(NPOI,IND ,5) * XPALB(I,ID3+3) * XRAYT ) +
421 : & ( XPTB(NPOI,IND ,6) * XPALB(I,ID3+2) * XRAYT ) )
422 : XVPC0(2) = (1.D0/ PDTS2) *
423 : & ( ( XPTB(NPOI,IND2,6) * XPALB(I,ID3+1) * XRAYT ) -
424 : & ( XPTB(NPOI,IND2,4) * XPALB(I,ID3+3) * XRAYT ) -
425 : & ( XPTB(NPOI,IND ,6) * XPALB(I,ID3+1) * XRAYT ) +
426 : & ( XPTB(NPOI,IND ,4) * XPALB(I,ID3+3) * XRAYT ) )
427 : XVPC0(3) = (1.D0/ PDTS2) *
428 : & ( ( XPTB(NPOI,IND2,4) * XPALB(I,ID3+2) * XRAYT ) -
429 : & ( XPTB(NPOI,IND2,5) * XPALB(I,ID3+1) * XRAYT ) -
430 : & ( XPTB(NPOI,IND ,4) * XPALB(I,ID3+2) * XRAYT ) +
431 : & ( XPTB(NPOI,IND ,5) * XPALB(I,ID3+1) * XRAYT ) )
432 : * si glissement au pas precedent, reactualisation de la position
433 : * origine d'adherence a l'aide du point de contact
434 : IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
435 : DO 257 ID=1,IDIM
436 : XPALB(I,ID7+ID) = XPTP2(ID)
437 : 257 CONTINUE
438 : ELSE
439 : PXVPC0 = 0.D0
440 : DO 258 ID = 1,IDIM
441 : PXVPC0 = PXVPC0 + XVPC0(ID)*XPALB(I,ID1+ID)
442 : 258 CONTINUE
443 : DO 259 ID = 1,IDIM
444 : XVPCT(ID) = XVPC0(ID) - PXVPC0 * XPALB(I,ID1+ID)
445 : 259 CONTINUE
446 : XPALB(I,ID7+1) = XPALB(I,ID7+1) +
447 : & (XVPCT(1)*PDTS2)*(XREXT/(XREXT-XRAYT))
448 : XPALB(I,ID7+2) = XPALB(I,ID7+2) +
449 : & (XVPCT(2)*PDTS2)*(XREXT/(XREXT-XRAYT))
450 : XPALB(I,ID7+3) = XPALB(I,ID7+3) +
451 : & (XVPCT(3)*PDTS2)*(XREXT/(XREXT-XRAYT))
452 : ENDIF
453 : * calcul du deplacement sur la normale au plan de section droite
454 : * et de l'ecart a la position orgine adherencee
455 : DO 260 ID = 1,IDIM
456 : IDD1 = 3 + ID
457 : IDD2 = 6 + ID
458 : IDD3 = 15 + ID
459 : XVALB(I,IND,IDD1) = XPTB(NPOI,IND,ID)
460 : XVALB(I,IND,IDD2) = (XPTP2(ID) - XPTPM2(ID) ) / PDTS2
461 : XVALB(I,IND,IDD3) = XPTB(NPOI,IND,ID+3)
462 : XPALB(I,ID4+ID) = XPTP2(ID) - XPTPM2(ID)
463 : & - (XVPC0(ID) * PDTS2)
464 : XPALB(I,ID5+ID) = XPTP2(ID) - XPALB(I,ID7+ID)
465 : 260 CONTINUE
466 : * end do
467 : * calcul de la vitesse tangentielle par derivee a gauche
468 : * et de l'ecart a la position orgine adherencee
469 : PSN = 0.D0
470 : PSN0 = 0.D0
471 : DO 262 ID = 1,IDIM
472 : PSN = PSN + XPALB(I,ID4+ID) * XPALB(I,ID3+ID)
473 : PSN0 = PSN0 + XPALB(I,ID5+ID) * XPALB(I,ID3+ID)
474 : 262 CONTINUE
475 : * end do
476 : DO 264 ID = 1,IDIM
477 : XPALB(I,ID4+ID) = (XPALB(I,ID4+ID) -
478 : & PSN * XPALB(I,ID3+ID))/PDTS2
479 : XPALB(I,ID5+ID) = XPALB(I,ID5+ID) -
480 : & PSN0 * XPALB(I,ID3+ID)
481 : 264 CONTINUE
482 : * end do
483 : * calcul de la force de choc
484 : IF (ITYP.EQ.25) THEN
484 : CALL DYCHE3(XDEP,IDIM,IGP,XPALB,NLIAB,I,INTER
485 : & ,XFN,XFT,XPUS,iannul)
486 : ELSE
487 : XVITN = PSN / PDTS2
488 : XVALB(I,IND,3) = XVITN
488 : CALL DYCHA3(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,INTER
489 : & ,XFN,XFT,XPUS,iannul)
490 : ENDIF
491 : XVALB(I,IND,1) = XFN
492 : XVALB(I,IND,10) = ABS(XFT)
493 : XVALB(I,IND,12) = XPUS
494 : IPALB(I,2) = IGP
495 : * si glissement, memorisation de la vitesse tangentielle et de la force
496 : * tangentielle
497 : IF (IGP.EQ.1) THEN
498 : DO 266 ID = 1,IDIM
499 : XPALB(I,ID8+ID) = XPALB(I,ID4+ID)
500 : XPALB(I,ID9+ID) = XPALB(I,ID6+ID)
501 : 266 CONTINUE
502 : ELSE
503 : DO 267 ID = 1,IDIM
504 : XPALB(I,ID9+ID) = 0.D0
505 : 267 CONTINUE
506 : * end do
507 : ENDIF
508 : DO 268 ID = 1,IDIM
509 : XFOR = ( XFN * XPALB(I,ID3+ID) ) + XPALB(I,ID6+ID)
510 : FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFOR
511 : XFNT(ID) = XPALB (I ,ID6+ID)
512 : 268 CONTINUE
513 : * end do
514 : XAPP1 = XRAYT * XPALB(I,ID3+1)
515 : XAPP2 = XRAYT * XPALB(I,ID3+2)
516 : XAPP3 = XRAYT * XPALB(I,ID3+3)
517 : XAPFP1 = ( XAPP2 * XFNT(3) ) - ( XAPP3 * XFNT(2) )
518 : XAPFP2 = ( XAPP3 * XFNT(1) ) - ( XAPP1 * XFNT(3) )
519 : XAPFP3 = ( XAPP1 * XFNT(2) ) - ( XAPP2 * XFNT(1) )
520 : XVALB(I,IND,13) = XAPFP1
521 : XVALB(I,IND,14) = XAPFP2
522 : XVALB(I,IND,15) = XAPFP3
523 : FTOTB(NPOI,4) = FTOTB(NPOI,4) + XAPFP1
524 : FTOTB(NPOI,5) = FTOTB(NPOI,5) + XAPFP2
525 : FTOTB(NPOI,6) = FTOTB(NPOI,6) + XAPFP3
526 : *
527 : * --- choc ...........
528 : *
529 : * else if (ityp.eq. ) then
530 : * .......
531 : * .......
532 : *
533 : ENDIF
534 : *
535 : END
536 :
537 :
538 :
539 :
540 :
541 :
542 :
© Cast3M 2003 - All rights reserved.
Disclaimer