1 : C DYN203 SOURCE PV 07/12/14 21:15:00 6005
2 : SUBROUTINE DYN203(I,ITLB,ITYP,KTLIAB,NPLB)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : *--------------------------------------------------------------------*
6 : * *
7 : * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
8 : * ________________________________________________ *
9 : * *
10 : * Remplissage des tableaux de description des liaisons sur *
11 : * la base @ partir des informations contenues dans la *
12 : * table ITLB (liaison de type ..._CERCLE). *
13 : * Liaison POINT_CERCLE avec ou sans amortissement *
14 : * Liaison POINT_CERCLE_FROTTEMENT avec ou sans amortissement *
15 : * Liaison POINT_CERCLE_MOBILE avec ou sans amortissement *
16 : * Liaison CERCLE_CERCLE_FROTTEMENT avec ou sans amortissement *
17 : * *
18 : * Param}tres: *
19 : * *
20 : * e I Num{ro de la liaison. *
21 : * e ITLB Table rassemblant la description d'une liaison. *
22 : * e ITYP Type de la liaison. *
23 : * s KTLIAB Segment descriptif des liaisons sur base B. *
24 : * e NPLB Nombre total de points. *
25 : * *
26 : * *
27 : * Auteur, date de cr{ation: *
28 : * *
29 : * Lionel VIVAN, le 5 D{cembre 1990. *
30 : * *
31 : *--------------------------------------------------------------------*
32 : -INC CCOPTIO
33 : -INC SMCOORD
34 : *
35 : SEGMENT MTLIAB
36 : INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
37 : REAL*8 XPALB(NLIAB,NXPALB)
38 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
39 : ENDSEGMENT
40 : *
41 : LOGICAL L1,L0,LINTER
42 : CHARACTER*8 MONAMO,MONINTER
43 : *
44 : LINTER=.TRUE.
45 : PS=0.D0
46 : MTLIAB = KTLIAB
47 : *
48 : * --- choc {l{mentaire POINT_CERCLE avec ou sans amortissement
49 : *
50 : IF (ITYP.EQ.21) THEN
50 : CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
51 : & 'POINT',I1,X1,' ',L1,IMOD)
52 : IF (IERR.NE.0) RETURN
52 : CALL ACCTAB(ITLB,'MOT',I0,X0,'EXCENTRATION',L0,IP0,
53 : & 'POINT',I1,X1,' ',L1,IEXC)
54 : IF (IERR.NE.0) RETURN
54 : CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
55 : & 'POINT',I1,X1,' ',L1,IPOI)
56 : IF (IERR.NE.0) RETURN
56 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
57 : & 'FLOTTANT',I0,XRAID,' ',L1,IP1)
58 : IF (IERR.NE.0) RETURN
58 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0,
59 : & 'FLOTTANT',I0,XRAYO,' ',L1,IP1)
60 : IF (IERR.NE.0) RETURN
61 : *
62 : MONAMO = ' '
62 : CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
63 : & MONAMO,I0,XAMON,' ',L1,IP1)
64 : IF (IERR.NE.0) RETURN
65 : *
66 : IPALB(I,1) = ITYP
67 : IPALB(I,3) = IDIM
68 : XPALB(I,1) = XRAID
69 : XPALB(I,2) = XRAYO
70 : *
71 : * normalisation de la normale
72 : *
73 : IPNV = (IDIM + 1) * (IPOI - 1)
74 : IPEX = (IDIM + 1) * (IEXC - 1)
75 : PS = 0.D0
76 : DO 10 ID = 1,IDIM
77 : XC = XCOOR(IPNV + ID)
78 : PS = PS + XC * XC
79 : 10 CONTINUE
80 : *** write (6,*) ' ps ',ps
81 : * end do
82 : IF (PS.LE.0.D0) THEN
82 : CALL ERREUR(162)
83 : RETURN
84 : ENDIF
85 : IF (MONAMO.EQ.'FLOTTANT') THEN
86 : IPALB(I,1) = 22
87 : XPALB(I,3) = XAMON
88 : ID1 = 3
89 : ELSE
90 : ID1 = 2
91 : ENDIF
92 : ID2 = ID1 + IDIM
93 : DO 12 ID = 1,IDIM
94 : XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
95 : XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
96 : 12 CONTINUE
97 : * end do
97 : CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
98 : IPLIB(I,1) = IPLAC
99 : *
100 : * --- choc {l{mentaire POINT_CERCLE_FROTTEMENT
101 : * avec ou sans amortissement
102 : *
103 : ELSE IF (ITYP.EQ.23) THEN
103 : CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
104 : & 'POINT',I1,X1,' ',L1,IMOD)
105 : IF (IERR.NE.0) RETURN
105 : CALL ACCTAB(ITLB,'MOT',I0,X0,'EXCENTRATION',L0,IP0,
106 : & 'POINT',I1,X1,' ',L1,IEXC)
107 : IF (IERR.NE.0) RETURN
107 : CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
108 : & 'POINT',I1,X1,' ',L1,IPOI)
109 : IF (IERR.NE.0) RETURN
109 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
110 : & 'FLOTTANT',I0,XRAIN,' ',L1,IP1)
111 : IF (IERR.NE.0) RETURN
111 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0,
112 : & 'FLOTTANT',I0,XRAYO,' ',L1,IP1)
113 : IF (IERR.NE.0) RETURN
113 : CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
114 : & 'FLOTTANT',I0,XGLIS,' ',L1,IP1)
115 : IF (IERR.NE.0) RETURN
115 : CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
116 : & 'FLOTTANT',I0,XADHE,' ',L1,IP1)
117 : IF (IERR.NE.0) RETURN
117 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
118 : & 'FLOTTANT',I0,XRAIT,' ',L1,IP1)
119 : IF (IERR.NE.0) RETURN
119 : CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
120 : & IP0,'FLOTTANT',I0,XAMOT,' ',L1,IP1)
121 : IF (IERR.NE.0) RETURN
122 :
123 : MONINTER = ' '
123 : CALL ACCTAB(ITLB,'MOT',I1,X0,'CONTACT_INTERIEUR',L0,
124 : & IP0,MONINTER,I0,X1,' ',LINTER,IP1)
125 : IF (IERR.NE.0) RETURN
126 : *
127 : MONAMO = ' '
127 : CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
128 : & MONAMO,I0,XAMON,' ',L1,IP1)
129 : IF (IERR.NE.0) RETURN
130 : *
131 : IPALB(I,1) = ITYP
132 : IPALB(I,3) = IDIM
133 : IPALB(I,4) = 1
134 : IF (.NOT.LINTER) THEN
135 : IPALB(I,4) = 0
136 : ENDIF
137 : XPALB(I,1) = XRAIN
138 : XPALB(I,2) = XRAYO
139 : XPALB(I,3) = XGLIS
140 : XPALB(I,4) = XADHE
141 : XPALB(I,5) = XRAIT
142 : XPALB(I,6) = XAMOT
143 : *
144 : * normalisation de la normale
145 : *
146 : IPNV = (IDIM + 1) * (IPOI - 1)
147 : IPEX = (IDIM + 1) * (IEXC - 1)
148 : PS = 0.D0
149 : DO 20 ID = 1,IDIM
150 : XC = XCOOR(IPNV + ID)
151 : PS = PS + XC * XC
152 : 20 CONTINUE
153 : *** write (6,*) ' ps - 2 ',ps
154 : * end do
155 : IF (PS.LE.0.D0) THEN
155 : CALL ERREUR(162)
156 : RETURN
157 : ENDIF
158 : IF (MONAMO.EQ.'FLOTTANT') THEN
159 : IPALB(I,1) = 24
160 : XPALB(I,7) = XAMON
161 : ID1 = 7
162 : ELSE
163 : ID1 = 6
164 : ENDIF
165 : ID2 = ID1 + IDIM
166 : DO 22 ID = 1,IDIM
167 : XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
168 : XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
169 : 22 CONTINUE
170 : * end do
170 : CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
171 : IPLIB(I,1) = IPLAC
172 :
173 : *
174 : * --- choc {l{mentaire POINT_CERCLE_MOBILE
175 : * avec ou sans amortissement
176 : *
177 : ELSE IF (ITYP.EQ.33) THEN
178 :
178 : CALL ACCTAB(ITLB,'MOT',I0,X0,'POINT',L0,IP0,
179 : & 'POINT',I1,X1,' ',L1,INOA)
180 : IF (IERR.NE.0) RETURN
180 : CALL ACCTAB(ITLB,'MOT',I0,X0,'CERCLE',L0,IP0,
181 : & 'POINT',I1,X1,' ',L1,INOB)
182 : IF (IERR.NE.0) RETURN
182 : CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
183 : & 'POINT',I1,X1,' ',L1,IPOI)
184 : IF (IERR.NE.0) RETURN
184 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
185 : & 'FLOTTANT',I0,XRAIN,' ',L1,IP1)
186 : IF (IERR.NE.0) RETURN
186 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0,
187 : & 'FLOTTANT',I0,XRAYO,' ',L1,IP1)
188 : IF (IERR.NE.0) RETURN
188 : CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
189 : & 'FLOTTANT',I0,XGLIS,' ',L1,IP1)
190 : IF (IERR.NE.0) RETURN
190 : CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
191 : & 'FLOTTANT',I0,XADHE,' ',L1,IP1)
192 : IF (IERR.NE.0) RETURN
192 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
193 : & 'FLOTTANT',I0,XRAIT,' ',L1,IP1)
194 : IF (IERR.NE.0) RETURN
194 : CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
195 : & IP0,'FLOTTANT',I0,XAMOT,' ',L1,IP1)
196 : IF (IERR.NE.0) RETURN
197 : MONINTER = ' '
197 : CALL ACCTAB(ITLB,'MOT',I1,X0,'CONTACT_INTERIEUR',L0,
198 : & IP0,MONINTER,I0,X1,' ',LINTER,IP1)
199 : IF (IERR.NE.0) RETURN
200 : *
201 : MONAMO = ' '
201 : CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
202 : & MONAMO,I0,XAMON,' ',L1,IP1)
203 : IF (IERR.NE.0) RETURN
204 : *
205 : IPALB(I,1) = ITYP
206 : IPALB(I,3) = IDIM
207 : IPALB(I,4) = 1
208 : IF (.NOT.LINTER) THEN
209 : IPALB(I,4) = 0
210 : ENDIF
211 : XPALB(I,1) = XRAIN
212 : XPALB(I,2) = XRAYO
213 : XPALB(I,3) = XGLIS
214 : XPALB(I,4) = XADHE
215 : XPALB(I,5) = XRAIT
216 : XPALB(I,6) = XAMOT
217 : *
218 : * normalisation de la normale
219 : *
220 : IPNV = (IDIM + 1) * (IPOI - 1)
221 : IPNOA = (IDIM + 1) * (INOA - 1)
222 : IPNOB = (IDIM + 1) * (INOB - 1)
223 : PS = 0.D0
224 : DO 202 ID = 1,IDIM
225 : XC = XCOOR(IPNV + ID)
226 : PS = PS + XC * XC
227 : 202 CONTINUE
228 : *** write (6,*) ' ps - 3 ',ps
229 : IF (PS.LE.0.D0) THEN
229 : CALL ERREUR(162)
230 : RETURN
231 : ENDIF
232 : IF (MONAMO.EQ.'FLOTTANT') THEN
233 : IPALB(I,1) = 34
234 : XPALB(I,7) = XAMON
235 : ID1 = 7
236 : ELSE
237 : ID1 = 6
238 : ENDIF
239 : ID2 = ID1 + IDIM
240 : DO 222 ID = 1,IDIM
241 : XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
242 : XPALB(I,ID2+ID) = XCOOR(IPNOB+ID) - XCOOR(IPNOA+ID)
243 : 222 CONTINUE
243 : CALL PLACE2(JPLIB,NPLB,IPLAC,INOA)
244 : IPLIB(I,1) = IPLAC
244 : CALL PLACE2(JPLIB,NPLB,IPLAC,INOB)
245 : IPLIB(I,2) = IPLAC
246 : *
247 : * --- choc {l{mentaire CERCLE_CERCLE_FROTTEMENT
248 : * avec ou sans amortissement
249 : *
250 : ELSE IF (ITYP.EQ.25) THEN
250 : CALL ACCTAB(ITLB,'MOT',I0,X0,'SUPPORT',L0,IP0,
251 : & 'POINT',I1,X1,' ',L1,IMOD)
252 : IF (IERR.NE.0) RETURN
252 : CALL ACCTAB(ITLB,'MOT',I0,X0,'EXCENTRATION',L0,IP0,
253 : & 'POINT',I1,X1,' ',L1,IEXC)
254 : IF (IERR.NE.0) RETURN
254 : CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
255 : & 'POINT',I1,X1,' ',L1,IPOI)
256 : IF (IERR.NE.0) RETURN
256 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
257 : & 'FLOTTANT',I0,XRAIN,' ',L1,IP1)
258 : IF (IERR.NE.0) RETURN
258 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON_BUTEE',L0,IP0,
259 : & 'FLOTTANT',I0,XRAYB,' ',L1,IP1)
260 : IF (IERR.NE.0) RETURN
260 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON_SUPPORT',L0,IP0,
261 : & 'FLOTTANT',I0,XRAYP,' ',L1,IP1)
262 : IF (IERR.NE.0) RETURN
262 : CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0,
263 : & 'FLOTTANT',I0,XGLIS,' ',L1,IP1)
264 : IF (IERR.NE.0) RETURN
264 : CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0,
265 : & 'FLOTTANT',I0,XADHE,' ',L1,IP1)
266 : IF (IERR.NE.0) RETURN
266 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0,
267 : & 'FLOTTANT',I0,XRAIT,' ',L1,IP1)
268 : IF (IERR.NE.0) RETURN
268 : CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0,
269 : & IP0,'FLOTTANT',I0,XAMOT,' ',L1,IP1)
270 : IF (IERR.NE.0) RETURN
271 : MONINTER = ' '
271 : CALL ACCTAB(ITLB,'MOT',I1,X0,'CONTACT_INTERIEUR',L0,
272 : & IP0,MONINTER,I0,X1,' ',LINTER,IP1)
273 : IF (IERR.NE.0) RETURN
274 : *
275 : MONAMO = ' '
275 : CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT',L0,IP0,
276 : & MONAMO,I0,XAMON,' ',L1,IP1)
277 : IF (IERR.NE.0) RETURN
278 : *
279 : IPALB(I,1) = ITYP
280 : IPALB(I,3) = IDIM
281 : IPALB(I,4) = 1
282 : IF (.NOT.LINTER) THEN
283 : IPALB(I,4) = 0
284 : ENDIF
285 : XPALB(I,1) = XRAIN
286 : XPALB(I,2) = XRAYB
287 : XPALB(I,3) = XGLIS
288 : XPALB(I,4) = XADHE
289 : XPALB(I,5) = XRAIT
290 : XPALB(I,6) = XAMOT
291 : *
292 : * normalisation de la normale
293 : *
294 : IPNV = (IDIM + 1) * (IPOI - 1)
295 : IPEX = (IDIM + 1) * (IEXC - 1)
296 : PS = 0.D0
297 : DO 30 ID = 1,IDIM
298 : XC = XCOOR(IPNV + ID)
299 : PS = PS + XC * XC
300 : 30 CONTINUE
301 : * end do
302 : *** write (6,*) ' ps - 4 ',ps
303 : IF (PS.LE.0.D0) THEN
303 : CALL ERREUR(162)
304 : RETURN
305 : ENDIF
306 : IF (MONAMO.EQ.'FLOTTANT') THEN
307 : ID1 = 7
308 : IPALB(I,1) = 26
309 : XPALB(I,7) = XAMON
310 : ELSE
311 : ID1 = 6
312 : ENDIF
313 : ID10 = ID1 + 9*IDIM
314 : XPALB(I,ID10+1) = XRAYP
315 : ID2 = ID1 + IDIM
316 : ID3 = ID1 + 2*IDIM
317 : DO 32 ID = 1,IDIM
318 : XPALB(I,ID1+ID) = XCOOR(IPNV + ID) / SQRT(PS)
319 : XPALB(I,ID2+ID) = XCOOR(IPEX + ID)
320 : 32 CONTINUE
321 : * end do
321 : CALL PLACE2(JPLIB,NPLB,IPLAC,IMOD)
322 : IPLIB(I,1) = IPLAC
323 : *
324 : * --- choc {l{mentaire ..._CERCLE...
325 : *
326 : * ELSE IF (ITYP.EQ. ) THEN
327 : * ...
328 : * ...
329 : ENDIF
330 : *
331 : END
332 :
333 :
334 :
335 :
336 :
337 :
338 :
339 :
© Cast3M 2003 - All rights reserved.
Disclaimer