1 : C DEVFB1 SOURCE CHAT 05/01/12 22:45:16 5004
2 : SUBROUTINE DEVFB1(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,
3 : & NPLB,IND,IND1,INDM1,NPA,NPAM1,IND2,PDT,PDTS2,
4 : & FEXPSM,NPC1,XABSCI,XORDON,NIP,I,iannul)
5 : IMPLICIT INTEGER(I-N)
6 : IMPLICIT REAL*8(A-H,O-Z)
7 : *--------------------------------------------------------------------*
8 : * *
9 : * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
10 : * ________________________________________________ *
11 : * *
12 : * Calcul des forces de choc sur base B pour les liaisons de *
13 : * type POINT_PLAN. *
14 : * *
15 : * Param}tres: *
16 : * *
17 : * e ITYP type de la liaison. *
18 : * es FTOTB Forces ext{rieures totalis{es sur la base B. *
19 : * e XPTB Tableau des d{placements des points *
20 : * e IPALB Renseigne sur la liaison. *
21 : * e IPLIB Tableau contenant les num{ros "DYNE" de la liaison. *
22 : * e XPALB Tableau contenant les param}tres 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 cr{ation: *
31 : * *
32 : * Lionel VIVAN : le 22 Septembre 1989 : Cr{ation *
33 : * Bertrand BEAUFILS : le 31 Mai 1990 : Ajout frottement sec*
34 : * *
35 : *--------------------------------------------------------------------*
36 : *
37 : INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
38 : REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*)
39 : REAL*8 XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*)
40 : REAL*8 XPTP2(3),XPTPP2(3),XFNT(3),XPSMP(3),XPSMPM(3)
41 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
42 : *
43 : * --- choc {l{mentaire POINT_PLAN
44 : * avec ou sans amortissement
45 : *
46 : IF (ITYP.EQ.1 .OR. ITYP.EQ.100
47 : & .OR. ITYP.EQ.101 .OR. ITYP.EQ.102) THEN
48 : NPOI = IPLIB(I,1)
49 : IDIM = IPALB(I,3)
50 : IPERM = IPALB(I,4)
51 : XRAID = XPALB(I,1)
52 : XJEU = XPALB(I,2)
53 : XAMO = XPALB(I,3)
54 : IF (ITYP.EQ.1 .OR. ITYP.EQ.102) THEN
55 : ID1 = 3
56 : ** ianis
57 : ELSE
58 : ID1 = 4
59 : XSEUIL = XPALB(I,ID1)
60 : XDPLAS = XPALB(I,(ID1+IDIM+1))
61 : ENDIF
62 : *
63 :
64 : XDEP = 0.D0
65 : DO 10 ID = 1,IDIM
66 : IDD1 = 3 + ID
67 : XDE2 = XPTB(NPOI,IND,ID)
68 : XVALB(I,IND,IDD1) = XDE2
69 : XDE2 = XDE2 + FEXPSM(NPOI,NPA,IND1,ID)
70 : XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
71 : 10 CONTINUE
72 : * end do
73 : XDEPM1 = 0.D0
74 : DO 12 ID = 1,IDIM
75 : XDM2 = XPTB(NPOI,IND2,ID) + FEXPSM(NPOI,NPAM1,INDM1,ID)
76 : XDEPM1 = XDEPM1 + XDM2 * XPALB(I,ID1+ID)
77 : 12 CONTINUE
78 : * end do
79 : XVIT = (XDEP - XDEPM1) / PDTS2
80 : XVALB(I,IND,3) = XVIT
81 : ** ianis
82 :
83 : IF (ITYP.EQ.1) THEN
83 : CALL DYCHAM(XDEP,XVIT,XRAID,XJEU,XAMO,XFL,IPERM,iannul)
84 :
85 : ELSE IF (ITYP.EQ.102) THEN
85 : CALL DYCHAM2(XDEP,XVIT,XJEU,XAMO,XABSCI,XORDON,NIP,
86 : & NLIAB,I,XFL,IPERM,iannul)
87 : ELSE IF (ITYP.EQ.101) THEN
87 : CALL DYCHPL2(XDEP,XVIT,XDPLAS,XRAID,XJEU,XAMO,XSEUIL,
88 : & XABSCI,XORDON,NIP,NLIAB,I,XFL,IPERM,iannul)
89 : ELSE IF (ITYP.EQ.100) THEN
89 : CALL DYCHPL(XDEP,XVIT,XDPLAS,XRAID,XJEU,XAMO,XSEUIL,
90 : & XFL,IPERM,iannul)
91 :
92 : ENDIF
93 : IF (ITYP.EQ.100 .OR. ITYP.EQ.101) THEN
94 : XPALB(I,(ID1+IDIM+1)) = XDPLAS
95 : XVALB(I,IND,13) = XDPLAS
96 : ENDIF
97 : *
98 :
99 : XVALB(I,IND,1) = XFL
100 : DO 14 ID = 1,IDIM
101 : FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFL * XPALB(I,ID1+ID)
102 : 14 CONTINUE
103 : * end do
104 : *
105 : * --- choc {l{mentaire POINT_PLAN_FROTTEMENT
106 : * avec ou sans amortissement
107 : *
108 : ELSE IF (ITYP.EQ.3 .OR. ITYP.EQ.103) THEN
109 : NPOI = IPLIB(I,1)
110 : IGP = IPALB(I,2)
111 : IDIM = IPALB(I,3)
112 : ID1 = 7
113 : ID2 = ID1 + IDIM
114 : ID3 = ID1 + 2*IDIM
115 : ID4 = ID1 + 3*IDIM
116 : ID5 = ID1 + 4*IDIM
117 : ID6 = ID1 + 5*IDIM
118 : ID7 = ID1 + 6*IDIM
119 : * Si glissement au pas pr{c{dent, r{actualisation de la position
120 : * origine d'adh{rence
121 : IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
122 : DO 30 ID=1,IDIM
123 : XPALB(I,ID5+ID) = XPTB(NPOI,IND,ID) +
124 : & FEXPSM(NPOI,NPA,IND1,ID)
125 : 30 CONTINUE
126 : * end do
127 : ENDIF
128 : * Calcul de l'enfoncement et de la vitesse normale
129 : XDEP = 0.D0
130 : PSN = 0.D0
131 : PSN0 = 0.D0
132 : DO 32 ID = 1,IDIM
133 : IDD1 = 3 + ID
134 : XDE2 = XPTB(NPOI,IND,ID)
135 : XDM2 = XPTB(NPOI,IND2,ID)
136 : XVALB(I,IND,IDD1) = XDE2
137 : XDE2 = XDE2 + FEXPSM(NPOI,NPA,IND1,ID)
138 : XDM2 = XDM2 + FEXPSM(NPOI,NPAM1,INDM1,ID)
139 : XPALB(I,ID2+ID) = XDE2 - XDM2
140 : XPALB(I,ID3+ID) = XDE2 - XPALB(I,ID5+ID)
141 : XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
142 : PSN = PSN + XPALB(I,ID2+ID) * XPALB(I,ID1+ID)
143 : PSN0 = PSN0 + XPALB(I,ID3+ID) * XPALB(I,ID1+ID)
144 : 32 CONTINUE
145 : * end do
146 : * Projette la vitesse et la variation de d{placement par rapport a
147 : * la position origine d'adh{rence sur le plan tangent
148 : DO 34 ID = 1,IDIM
149 : XPALB(I,ID2+ID) = (XPALB(I,ID2+ID) - PSN * XPALB(I,ID1+ID))
150 : & / PDTS2
151 : XPALB(I,ID3+ID) = XPALB(I,ID3+ID) - PSN0 * XPALB(I,ID1+ID)
152 : 34 CONTINUE
153 : * end do
154 : XVITN = PSN / PDTS2
155 : XVALB(I,IND,3) = XVITN
156 : IF (ITYP.EQ.3) THEN
156 : CALL DYCHA4(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS,
157 : & iannul)
158 : ELSE
158 : CALL DYCHA41(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS,
159 : & XABSCI,XORDON,NIP,iannul)
160 : ENDIF
161 : XVALB(I,IND,1) = XFN
162 : XVALB(I,IND,10) = ABS(XFT)
163 : XVALB(I,IND,12) = XPUS
164 : IPALB(I,2) = IGP
165 :
166 : IF (IGP .EQ. 1) THEN
167 : PS = 0.D0
168 : DO 20 ID = 1,IDIM
169 : PS = PS + (XPALB(I,ID2+ID)*XPALB(I,ID2+ID))
170 : 20 CONTINUE
171 : XVITT = SQRT(PS)
172 : ELSE
173 : XVITT = 0.D0
174 : ENDIF
175 : XVALB(I,IND,11) = XVITT
176 : * Si glissement, m{morisation de la vitesse tangentielle et de la force
177 : * tangentielle
178 : IF (IGP.EQ.1.OR.IGP.EQ.-1) THEN
179 : DO 36 ID = 1,IDIM
180 : XPALB(I,ID6+ID) = XPALB(I,ID2+ID)
181 : XPALB(I,ID7+ID) = XPALB(I,ID4+ID)
182 : 36 CONTINUE
183 : * end do
184 : ENDIF
185 : DO 38 ID = 1,IDIM
186 : FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFN * XPALB(I,ID1+ID)
187 : & + XPALB(I,ID4+ID)
188 : 38 CONTINUE
189 : * end do
190 : *
191 : * --- choc {l{mentaire CERCLE_PLAN_FROTTEMENT
192 : * avec ou sans amortissement
193 : *
194 : ELSE IF (ITYP.EQ.5 .OR. ITYP.EQ.6) THEN
195 : NPOI = IPLIB(I,1)
196 : IGP = IPALB(I,2)
197 : IDIM = IPALB(I,3)
198 : IF (ITYP.EQ.5) THEN
199 : ID1 = 6
200 : ELSE
201 : ID1 = 7
202 : ENDIF
203 : ID2 = ID1 + IDIM
204 : ID3 = ID1 + 2*IDIM
205 : ID4 = ID1 + 3*IDIM
206 : ID5 = ID1 + 4*IDIM
207 : ID6 = ID1 + 5*IDIM
208 : ID7 = ID1 + 6*IDIM
209 : ID8 = ID1 + 1 + 7*IDIM
210 : * calcul du d{placement du point de contact au pas pr{c{dent
211 : XMP1 = XPALB(I,ID1+1) * XPALB(I,ID8)
212 : XMP2 = XPALB(I,ID1+2) * XPALB(I,ID8)
213 : XMP3 = XPALB(I,ID1+3) * XPALB(I,ID8)
214 : XPTPP2(1) = XPTB(NPOI,IND2,1) +
215 : & ( ( XPTB(NPOI,IND2,5) * XMP3 ) -
216 : & ( XPTB(NPOI,IND2,6) * XMP2 ) )
217 : XPTPP2(2) = XPTB(NPOI,IND2,2) +
218 : & ( ( XPTB(NPOI,IND2,6) * XMP1 ) -
219 : & ( XPTB(NPOI,IND2,4) * XMP3 ) )
220 : XPTPP2(3) = XPTB(NPOI,IND2,3) +
221 : & ( ( XPTB(NPOI,IND2,4) * XMP2 ) -
222 : & ( XPTB(NPOI,IND2,5) * XMP1 ) )
223 : XPSMPM(1) = FEXPSM(NPOI,NPAM1,INDM1,1) +
224 : & ( ( FEXPSM(NPOI,NPAM1,INDM1,5) * XMP3 ) -
225 : & ( FEXPSM(NPOI,NPAM1,INDM1,6) * XMP2 ) )
226 : XPSMPM(2) = FEXPSM(NPOI,NPAM1,INDM1,2) +
227 : & ( ( FEXPSM(NPOI,NPAM1,INDM1,6) * XMP1 ) -
228 : & ( FEXPSM(NPOI,NPAM1,INDM1,4) * XMP3 ) )
229 : XPSMPM(3) = FEXPSM(NPOI,NPAM1,INDM1,3) +
230 : & ( ( FEXPSM(NPOI,NPAM1,INDM1,4) * XMP2 ) -
231 : & ( FEXPSM(NPOI,NPAM1,INDM1,5) * XMP1 ) )
232 : * calcul du d{placement du point de contact au pas courant
233 : XPTP2(1) = XPTB(NPOI,IND,1) +
234 : & ( ( XPTB(NPOI,IND,5) * XMP3 ) -
235 : & ( XPTB(NPOI,IND,6) * XMP2 ) )
236 : XPTP2(2) = XPTB(NPOI,IND,2) +
237 : & ( ( XPTB(NPOI,IND,6) * XMP1 ) -
238 : & ( XPTB(NPOI,IND,4) * XMP3 ) )
239 : XPTP2(3) = XPTB(NPOI,IND,3) +
240 : & ( ( XPTB(NPOI,IND,4) * XMP2 ) -
241 : & ( XPTB(NPOI,IND,5) * XMP1 ) )
242 : XPSMP(1) = FEXPSM(NPOI,NPA,IND1,1) +
243 : & ( ( FEXPSM(NPOI,NPA,IND1,5) * XMP3 ) -
244 : & ( FEXPSM(NPOI,NPA,IND1,6) * XMP2 ) )
245 : XPSMP(2) = FEXPSM(NPOI,NPA,IND1,2) +
246 : & ( ( FEXPSM(NPOI,NPA,IND1,6) * XMP1 ) -
247 : & ( FEXPSM(NPOI,NPA,IND1,4) * XMP3 ) )
248 : XPSMP(3) = FEXPSM(NPOI,NPA,IND1,3) +
249 : & ( ( FEXPSM(NPOI,NPA,IND1,4) * XMP2 ) -
250 : & ( FEXPSM(NPOI,NPA,IND1,5) * XMP1 ) )
251 : *
252 : * Si glissement au pas pr{c{dent, r{actualisation de la position
253 : * origine d'adh{rence
254 : IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
255 : DO 50 ID=1,IDIM
256 : XPALB(I,ID5+ID) = XPTP2(ID) + XPSMP(ID)
257 : 50 CONTINUE
258 : * end do
259 : ENDIF
260 : * Calcul de l'enfoncement et de la vitesse normale
261 : XDEP = 0.D0
262 : PSN = 0.D0
263 : PSN0 = 0.D0
264 : DO 52 ID = 1,IDIM
265 : IDD1 = 3 + ID
266 : IDD2 = 6 + ID
267 : IDD3 = 15 + ID
268 : XDE2 = XPTP2(ID)
269 : XDM2 = XPTPP2(ID)
270 : XVALB(I,IND,IDD1) = XPTB(NPOI,IND,ID)
271 : XVALB(I,IND,IDD2) = (xDE2 - xdm2 ) / pdts2
272 : XVALB(I,IND,IDD3) = XPTB(NPOI,IND,ID+3)
273 : XDE2 = XDE2 + XPSMP(ID)
274 : XDM2 = XDM2 + XPSMPM(ID)
275 : XPALB(I,ID2+ID) = XDE2 - XDM2
276 : XPALB(I,ID3+ID) = XDE2 - XPALB(I,ID5+ID)
277 : XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
278 : PSN = PSN + XPALB(I,ID2+ID) * XPALB(I,ID1+ID)
279 : PSN0 = PSN0 + XPALB(I,ID3+ID) * XPALB(I,ID1+ID)
280 : 52 CONTINUE
281 : * end do
282 : * Projette la vitesse et la variation de d{placement par rapport a
283 : * la position origine d'adh{rence sur le plan tangent
284 : DO 54 ID = 1,IDIM
285 : XPALB(I,ID2+ID) = (XPALB(I,ID2+ID) - PSN * XPALB(I,ID1+ID))
286 : & / PDTS2
287 : XPALB(I,ID3+ID) = XPALB(I,ID3+ID) - PSN0 * XPALB(I,ID1+ID)
288 : 54 CONTINUE
289 : * end do
290 : IF (ITYP.EQ.5) THEN
290 : CALL DYCHE4(XDEP,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS,
291 : & iannul)
292 : ELSE
293 : XVITN = PSN / PDTS2
294 : XVALB(I,IND,3) = XVITN
294 : CALL DYCHA4(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS,
295 : & iannul)
296 : ENDIF
297 : XVALB(I,IND,1) = XFN
298 : XVALB(I,IND,10) = ABS(XFT)
299 : XVALB(I,IND,12) = XPUS
300 : IPALB(I,2) = IGP
301 : * Si glissement, m{morisation de la vitesse tangentielle et de la force
302 : * tangentielle
303 : IF (IGP.EQ.1.OR.IGP.EQ.-1) THEN
304 : DO 56 ID = 1,IDIM
305 : XPALB(I,ID6+ID) = XPALB(I,ID2+ID)
306 : XPALB(I,ID7+ID) = XPALB(I,ID4+ID)
307 : 56 CONTINUE
308 : * end do
309 : ENDIF
310 : DO 58 ID = 1,IDIM
311 : XFOR = ( XFN * XPALB(I,ID1+ID) ) + XPALB(I,ID4+ID)
312 : XFNT(ID) = XFOR
313 : FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFOR
314 : 58 CONTINUE
315 : * end do
316 : XMPFP1 = ( XMP2 * XFNT(3) ) - ( XMP3 * XFNT(2) )
317 : XMPFP2 = ( XMP3 * XFNT(1) ) - ( XMP1 * XFNT(3) )
318 : XMPFP3 = ( XMP1 * XFNT(2) ) - ( XMP2 * XFNT(1) )
319 : XVALB(I,IND,13) = XMPFP1
320 : XVALB(I,IND,14) = XMPFP2
321 : XVALB(I,IND,15) = XMPFP3
322 : FTOTB(NPOI,4) = FTOTB(NPOI,4) + XMPFP1
323 : FTOTB(NPOI,5) = FTOTB(NPOI,5) + XMPFP2
324 : FTOTB(NPOI,6) = FTOTB(NPOI,6) + XMPFP3
325 : *
326 : * --- choc {l{mentaire POINT_PLAN_FLUIDE
327 : *
328 : ELSE IF (ITYP.EQ.7) THEN
329 : NPOI = IPLIB(I,1)
330 : IDIM = IPALB(I,3)
331 : XINER = XPALB(I,1)
332 : XCONV = XPALB(I,2)
333 : XVISC = XPALB(I,3)
334 : XPCEL = XPALB(I,4)
335 : XPCRA = XPALB(I,5)
336 : XJEU = XPALB(I,6)
337 : ID1 = 6
338 : ID2 = ID1 + IDIM
339 : XDEP = 0.D0
340 : DO 70 ID = 1,IDIM
341 : XDE2 = XPTB(NPOI,IND,ID)
342 : XVALB(I,IND,ID) = XDE2
343 : XDE2 = XDE2 + FEXPSM(NPOI,NPA,IND1,ID)
344 : XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
345 : 70 CONTINUE
346 : * end do
347 : XDEPM1 = XPALB(I,ID2+1)
348 : XVITM1 = XPALB(I,ID2+2)
349 : XACCM1 = XPALB(I,ID2+3)
350 : XVIT = (XDEP - XDEPM1) / PDTS2
351 : XACC = (XVIT - XVITM1) / PDTS2
352 : XPALB(I,ID2+1) = XDEP
353 : XPALB(I,ID2+2) = XVIT
354 : XPALB(I,ID2+3) = XACC
355 : XDH = XJEU - XDEP
356 : * Calcul de la force d'inertie
356 : CALL DYFINE(XDH,XDEP,XACC,XJEU,XINER,XFI,iannul)
357 : * Calcul de la force de convection
357 : CALL DYFCON(XDH,XDEP,XVIT,XJEU,XCONV,XFC,iannul)
358 : * Calcul de la force de viscosit{
358 : CALL DYFVIS(XDH,XDEP,XVIT,XJEU,XVISC,XFV,iannul)
359 : * Calcul de la force de perte de charge
359 : CALL DYFPDC(XDH,XDEP,XVIT,XJEU,XPCEL,XPCRA,XFP,iannul)
360 : *
361 : XFL = XFI + XFC + XFV + XFP
362 : DO 72 ID = 1,IDIM
363 : FTOTB(NPOI,ID) = FTOTB(NPOI,ID) + XFL * XPALB(I,ID1+ID)
364 : 72 CONTINUE
365 : * end do
366 : XVALB(I,IND,IDIM+1) = XVIT
367 : XVALB(I,IND,IDIM+2) = XACC
368 : XVALB(I,IND,IDIM+3) = XFI
369 : XVALB(I,IND,IDIM+4) = XFC
370 : XVALB(I,IND,IDIM+5) = XFV
371 : XVALB(I,IND,IDIM+6) = XFP
372 : *
373 : * --- choc ...........
374 : *
375 : * ELSE IF (ITYP.EQ. ) THEN
376 : * .......
377 : * .......
378 : *
379 : ENDIF
380 : *
381 : END
382 :
383 :
384 :
385 :
386 :
387 :
© Cast3M 2003 - All rights reserved.
Disclaimer