1 : C DEVFB2 SOURCE PV 08/04/18 21:15:01 6094
2 : SUBROUTINE DEVFB2(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_POINT. *
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 : * *
34 : *--------------------------------------------------------------------*
35 : *
36 : INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)
37 : REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*)
38 : REAL*8 XVALB(NLIAB,4,*),FEXPSM(NPLB,NPC1,2,*)
39 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
40 :
41 : *
42 : *
43 : * --- choc {l{mentaire POINT_POINT avec amortissement
44 : *
45 : IF (ITYP.EQ.11 .OR. ITYP.EQ.111) THEN
46 : NPOA = IPLIB(I,1)
47 : NPOB = IPLIB(I,2)
48 : IDIM = IPALB(I,3)
49 : IPERM = IPALB(I,4)
50 : XRAID = XPALB(I,1)
51 : XJEU = XPALB(I,2)
52 : XAMO = XPALB(I,3)
53 : XDEP = 0.D0
54 : XDEPM1 = 0.D0
55 : DO 20 ID = 1,IDIM
56 : IDA = 3 + ID
57 : IDB = 3 + IDIM + ID
58 : XDEA = XPTB(NPOA,IND,ID)
59 : XDMA = XPTB(NPOA,IND2,ID)
60 : XDEB = XPTB(NPOB,IND,ID)
61 : XDMB = XPTB(NPOB,IND2,ID)
62 : XVALB(I,IND,IDA) = XDEA
63 : XVALB(I,IND,IDB) = XDEB
64 : XDEA = XDEA + FEXPSM(NPOA,NPA,IND1,ID)
65 : XDEB = XDEB + FEXPSM(NPOB,NPA,IND1,ID)
66 : XDMA = XDMA + FEXPSM(NPOA,NPAM1,INDM1,ID)
67 : XDMB = XDMB + FEXPSM(NPOB,NPAM1,INDM1,ID)
68 : XDEP = XDEP + (XDEA - XDEB) * XPALB(I,3+ID)
69 : XDEPM1 = XDEPM1 + (XDMA - XDMB) * XPALB(I,3+ID)
70 : 20 CONTINUE
71 : * end do
72 : XVIT = (XDEP - XDEPM1) / PDTS2
73 : XVALB(I,IND,3) = XVIT
74 : IF (ITYP.EQ.11) THEN
74 : CALL DYCHAM(XDEP,XVIT,XRAID,XJEU,XAMO,XFLA,IPERM,iannul)
75 : ELSE
75 : CALL DYCHAM2(XDEP,XVIT,XJEU,XAMO,XABSCI,XORDON,NIP,
76 : & NLIAB,I, XFLA,IPERM,iannul)
77 : ENDIF
78 : XFLB = -1.D0 * XFLA
79 : XVALB(I,IND,1) = XFLA
80 : XVALB(I,IND,2) = XFLB
81 : DO 22 ID = 1,IDIM
82 : FTOTB(NPOA,ID) = FTOTB(NPOA,ID) + XFLA * XPALB(I,3+ID)
83 : FTOTB(NPOB,ID) = FTOTB(NPOB,ID) + XFLB * XPALB(I,3+ID)
84 : 22 CONTINUE
85 : * end do
86 : *
87 : * --- choc {l{mentaire POINT_POINT_FROTTEMENT avec ou sans amortissement
88 : *
89 : ELSEIF ((ITYP.EQ.13) .or. ( ityp .eq. 113)) THEN
90 : NPOA = IPLIB(I,1)
91 : NPOB = IPLIB(I,2)
92 : IGP = IPALB(I,2)
93 : IDIM = IPALB(I,3)
94 : ID1 = 7
95 : ID2 = ID1 + IDIM
96 : ID3 = ID1 + 2*IDIM
97 : ID4 = ID1 + 3*IDIM
98 : ID5 = ID1 + 4*IDIM
99 : ID6 = ID1 + 5*IDIM
100 : ID7 = ID1 + 6*IDIM
101 : * Si glissement au pas pr{c{dent, r{actualisation de la position-ecart
102 : * origine d'adh{rence
103 : IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
104 : DO 30 ID=1,IDIM
105 : XPALB(I,ID5+ID) =(XPTB(NPOa,IND,ID) +
106 : & FEXPSM(NPOa,NPA,IND1,ID) )
107 : & - ( XPTB(NPOb,IND,ID) +
108 : & FEXPSM(NPOb,NPA,IND1,ID))
109 : 30 CONTINUE
110 : * end do
111 : ENDIF
112 : * Calcul de l'enfoncement relatif et de la vitesse normale relative
113 : XDEP = 0.D0
114 : PSN = 0.D0
115 : PSN0 = 0.D0
116 : DO 32 ID = 1,IDIM
117 : IDD1 = 3 + ID
118 : xvalb(i,ind,idd1) = XPTB(NPOa,IND,ID)
119 : xvalb(i,ind,idd1 + idim) = XPTB(NPOb,IND,ID)
120 : XDE2 = XPTB(NPOa,IND,ID) - xptb (npob,ind,id)
121 : XDE2 = XDE2 + FEXPSM(NPOa,NPA,IND1,ID)
122 : & - FEXPSM(NPOb,NPA,IND1,ID)
123 : XDm2 = XPTB(NPOa,IND2,ID) - xptb (npob,ind2,id)
124 : XDM2 = XDM2 + FEXPSM(NPOA,NPAM1,INDM1,ID)
125 : & - FEXPSM(NPOb,NPAM1,INDM1,ID)
126 : XPALB(I,ID2+ID) = XDE2 - XDM2
127 : XPALB(I,ID3+ID) = XDE2 - XPALB(I,ID5+ID)
128 : XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
129 : PSN = PSN + XPALB(I,ID2+ID) * XPALB(I,ID1+ID)
130 : PSN0 = PSN0 + XPALB(I,ID3+ID) * XPALB(I,ID1+ID)
131 : 32 CONTINUE
132 : * end do
133 : * Projette la vitesse relative
134 : * et la variation de d{placement relatif par rapport a
135 : * l' ecart origine d'adh{rence sur le plan tangent
136 : DO 34 ID = 1,IDIM
137 : XPALB(I,ID2+ID) = (XPALB(I,ID2+ID) - PSN * XPALB(I,ID1+ID))
138 : & / PDTS2
139 : XPALB(I,ID3+ID) = XPALB(I,ID3+ID) - PSN0 * XPALB(I,ID1+ID)
140 : 34 CONTINUE
141 : * end do
142 : XVITN = PSN / PDTS2
143 : XVALB(I,IND,3) = XVITN
144 : IF (ITYP.EQ.13) THEN
144 : CALL DYCHA4(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS
145 : & ,iannul)
146 : ELSE
146 : CALL DYCHA41(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS,
147 : & XABSCI,XORDON,NIP,iannul)
148 : ENDIF
149 :
150 : Xfla = XFN
151 : Xflb = -1d0 * XFN
152 : XVALB(I,IND,1) = XFla
153 : XVALB(I,IND,2) = XFlb
154 : XVALB(I,IND,10) = ABS(XFT)
155 : XVALB(I,IND,12) = XPUS
156 : IPALB(I,2) = IGP
157 : * Si glissement, m{morisation de la vitesse tangentielle et de la force
158 : * tangentielle
159 : IF (IGP.EQ.1.OR.IGP.EQ.-1) THEN
160 : DO 36 ID = 1,IDIM
161 : XPALB(I,ID6+ID) = XPALB(I,ID2+ID)
162 : XPALB(I,ID7+ID) = XPALB(I,ID4+ID)
163 : 36 CONTINUE
164 : * end do
165 : ENDIF
166 : DO 38 ID = 1,IDIM
167 : FTOTB(NPOa,ID) = FTOTB(NPOa,ID) + XFla* XPALB(I,ID1+ID)
168 : & + XPALB(I,ID4+ID)
169 : FTOTB(NPOb,ID) = FTOTB(NPOb,ID) + XFlb* XPALB(I,ID1+ID)
170 : & - XPALB(I,ID4+ID)
171 : 38 CONTINUE
172 :
173 : *****************************************************************
174 :
175 :
176 : *
177 : ** modele de Nedjai. On ne garantit rien
178 :
179 : ELSEIF (ITYP.EQ.-13) THEN
180 : NPOA = IPLIB(I,1)
181 : NPOB = IPLIB(I,2)
182 : IGP = IPALB(I,2)
183 : IDIM = IPALB(I,3)
184 : ID1 = 7
185 : ID2 = ID1 + IDIM
186 : ID3 = ID1 + 2*IDIM
187 : ID4 = ID1 + 3*IDIM
188 : ID5 = ID1 + 4*IDIM
189 : ID6 = ID1 + 5*IDIM
190 : ID7 = ID1 + 6*IDIM
191 : * Si glissement au pas pr{c{dent, r{actualisation de la position-ecart
192 : * origine d'adh{rence
193 : IF (IGP.EQ.1 .OR. IGP.EQ.-1) THEN
194 : DO 130 ID=1,IDIM
195 : XPALB(I,ID5+ID) =(XPTB(NPOa,IND,ID) +
196 : & FEXPSM(NPOa,NPA,IND1,ID) )
197 : & - ( XPTB(NPOb,IND,ID) +
198 : & FEXPSM(NPOb,NPA,IND1,ID))
199 : 130 CONTINUE
200 : * end do
201 : ENDIF
202 : * Calcul de l'enfoncement relatif et de la vitesse normale relative
203 : XDEP = 0.D0
204 : PSN = 0.D0
205 : PSN0 = 0.D0
206 : DO 132 ID = 1,IDIM
207 : IDD1 = 3 + ID
208 : xvalb(i,ind,idd1) = XPTB(NPOa,IND,ID)
209 : xvalb(i,ind,idd1 + idim) = XPTB(NPOb,IND,ID)
210 : XDE2 = XPTB(NPOa,IND,ID) - xptb (npob,ind,id)
211 : XDE2 = XDE2 + FEXPSM(NPOa,NPA,IND1,ID)
212 : & - FEXPSM(NPOb,NPA,IND1,ID)
213 : XDm2 = XPTB(NPOa,IND2,ID) - xptb (npob,ind2,id)
214 : XDM2 = XDM2 + FEXPSM(NPOA,NPAM1,INDM1,ID)
215 : & - FEXPSM(NPOb,NPAM1,INDM1,ID)
216 : ***
217 : * WRITE(6,*) 'devfb2 XDE2 ', XDE2
218 : * WRITE(6,*) 'devfb2 XDM2 ', XDM2
219 : ***
220 : XPALB(I,ID2+ID) = XDE2 - XDM2
221 : *A ENLEVER**XPALB(I,ID3+ID) = XDE2 - XPALB(I,ID5+ID)
222 : XDEP = XDEP + XDE2 * XPALB(I,ID1+ID)
223 : PSN = PSN + XPALB(I,ID2+ID) * XPALB(I,ID1+ID)
224 : PSN0 = PSN0 + XPALB(I,ID3+ID) * XPALB(I,ID1+ID)
225 : 132 CONTINUE
226 : * end do
227 : * Projette la vitesse relative
228 : * et la variation de d{placement relatif par rapport a
229 : * l' ecart origine d'adh{rence sur le plan tangent
230 : DO 134 ID = 1,IDIM
231 : XPALB(I,ID2+ID) = (XPALB(I,ID2+ID) - PSN * XPALB(I,ID1+ID))
232 : & / PDTS2
233 : *A enlever**XPALB(I,ID3+ID) = XPALB(I,ID3+ID) - PSN0 * XPALB(I,ID1+ID)
234 : **** RAJOUT D UN ORDRE D IMPRESSION
235 : *************************************
236 : * WRITE(6,*) 'devfb2 XPALB',XPALB(I,ID1+ID)
237 : * WRITE(6,*) 'devfb2 XPALB',XPALB(I,ID2+ID)
238 : * WRITE(6,*) 'devfb2 XPALB',XPALB(I,ID3+ID)
239 : 134 CONTINUE
240 : * end do
241 : XVITN = PSN / PDTS2
242 : XVALB(I,IND,3) = XVITN
243 :
243 : ***RAJOUT DE XPAS DANS CALL DYCHA4
243 : CALL DGCHA4(XDEP,XVITN,IDIM,IGP,XPALB,NLIAB,I,XFN,XFT,XPUS
244 : & ,iannul,PDTS2)
245 :
246 :
247 : Xfla = XFN
248 : Xflb = -1d0 * XFN
249 : XVALB(I,IND,1) = XFla
250 : XVALB(I,IND,2) = XFlb
251 : XVALB(I,IND,10) = ABS(XFT)
252 : XVALB(I,IND,12) = XPUS
253 : IPALB(I,2) = IGP
254 : * Si glissement, m{morisation de la vitesse tangentielle et de la force
255 : * tangentielle
256 : *AENLEV**IF (IGP.EQ.1.OR.IGP.EQ.-1) THEN
257 : DO 136 ID = 1,IDIM
258 : **ON A REMPLACE ID6 PAR ID3 (NEDJAI)
259 : XPALB(I,ID3+ID) = XPALB(I,ID2+ID)
260 : XPALB(I,ID7+ID) = XPALB(I,ID4+ID)
261 : 136 CONTINUE
262 : * end do
263 : **AENLEV**ENDIF
264 : DO 138 ID = 1,IDIM
265 : FTOTB(NPOa,ID) = FTOTB(NPOa,ID) + XFla* XPALB(I,ID1+ID)
266 : & + XPALB(I,ID4+ID)
267 : FTOTB(NPOb,ID) = FTOTB(NPOb,ID) + XFlb* XPALB(I,ID1+ID)
268 : & - XPALB(I,ID4+ID)
269 : 138 CONTINUE
270 :
271 : *
272 : * --- choc ...........
273 : *
274 : * ELSE IF (ITYP.EQ. ) THEN
275 : * .......
276 : * .......
277 : *
278 : ENDIF
279 : *
280 : END
281 :
282 :
283 :
284 :
285 :
286 :
© Cast3M 2003 - All rights reserved.
Disclaimer