1 : C DYNE19 SOURCE CHAT 06/06/01 21:16:22 5450
2 : SUBROUTINE DYNE19(ILIA,KCPR,PDT,KTLIAA)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : *--------------------------------------------------------------------*
6 : * *
7 : * Operateur DYNE : algorithme de Fu - de Vogelaere *
8 : * ________________________________________________ *
9 : * *
10 : * Remplissage des tableaux de description des liaisons sur *
11 : * la base a partir des informations contenues dans la *
12 : * table ILIA. *
13 : * *
14 : * Parametres: *
15 : * *
16 : * e ILIA Table rassemblant la description des liaisons *
17 : * e KCPR Segment descriptif des points. *
18 : * e PDT Pas de temps. *
19 : * es KTLIAA Segment descriptif des liaisons sur la base A. *
20 : * *
21 : * Parametres de dimensionnement pour une liaison sur base: *
22 : * *
23 : * NIPALA : nombre de parametres pour definir le type des *
24 : * liaisons (NIPALA est fixe a 3). *
25 : * NXPALA : nombre maxi de parametres internes pour definir *
26 : * les liaisons. *
27 : * NPLAA : nombre maxi de points intervenant dans une liaison. *
28 : * *
29 : * NPLA : nombre total de points. *
30 : * NLIAA : nombre total de liaisons. *
31 : * *
32 : * *
33 : * Tableaux fortran pour les liaisons sur base: *
34 : * *
35 : * XPALA(NLIAA,NXPALA) : param}tres de la liaison. *
36 : * IPALA(NLIAA,NIPALA) : renseigne sur le type de liaison. *
37 : * JPLIA(NPLA) : num{ro global des points. *
38 : * IPLIA(NLIAA,NPLAA) : num{ros locaux des points concern{s par *
39 : * la liaison. *
40 : * *
41 : * Auteur, date de cr{ation: *
42 : * *
43 : * Lionel VIVAN, le 21 aout 1989. *
44 : * *
45 : *--------------------------------------------------------------------*
46 : *
47 : -INC CCOPTIO
48 : -INC CCNOYAU
49 : -INC SMCOORD
50 : -INC SMTABLE
51 : -INC CCASSIS
52 : *
53 : SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))
54 : *
55 : SEGMENT MTLIAA
56 : INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
57 : REAL*8 XPALA(NLIAA,NXPALA)
58 : ENDSEGMENT
59 : SEGMENT icorres (nliaa)
60 : *
61 : LOGICAL L0,L1
62 : CHARACTER*8 MONAMO,MONOBJ,TYPIND,TYPOBJ,CHARRE
63 : CHARACTER*40 CMOT,MONMOT
64 : CHARACTER*(20) CHAI1
65 : CHARACTER*(18) CHAI2
66 : CHARACTER*(15) CHAI3
67 : CHARACTER*(16) CHAI4
68 : CHARACTER*(14) CHAI5
69 : CHARACTER*(11) CHAI6
70 : PARAMETER (XZERO = 0.D0)
71 : DATA CHAI1 /'EXPOSANT_DEPLACEMENT'/
72 : DATA CHAI2 /'RETARD_DEPLACEMENT'/
73 : DATA CHAI3 /'JEU_DEPLACEMENT'/
74 : DATA CHAI4 /'EXPOSANT_VITESSE'/
75 : DATA CHAI5 /'RETARD_VITESSE'/
76 : DATA CHAI6 /'JEU_VITESSE'/
77 : *
78 : ICPR = KCPR
79 : MTLIAA = KTLIAA
80 : NLIAA = IPALA(/1)
81 : NXPALA = XPALA(/2)
82 : NIPALA = IPALA(/2)
83 : NPLAA = IPLIA(/2)
84 : NPLA = JPLIA(/1)
85 : XPDTS2 = 0.5 * PDT
86 :
87 : segini icorres
88 : *
89 : * Boucle sur le nombre de liaisons
90 : *
91 : II = 0
92 : DO 10 I = 1,NLIAA
92 : CALL ACCTAB(ILIA,'ENTIER',I,X0,' ',L0,IP0,
93 : & 'TABLE',I0,X0,' ',L1,ITLIAI)
94 : IF (IERR.NE.0) RETURN
95 : icorres ( i ) = itliai
96 :
96 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
97 : & 'MOT',I1,X0,MONMOT,L1,IP1)
98 : IF (IERR.NE.0) RETURN
99 : *
100 : * Liaison {l{mentaire
101 : *
102 : IF (MONMOT(1:19).EQ.'LIAISON_ELEMENTAIRE') THEN
102 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0,
103 : & 'MOT',I1,X0,CMOT,L1,IP1)
104 : IF (IERR.NE.0) RETURN
105 : *
106 : IF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN
107 : *
108 : * ------------ choc POINT_PLAN_FLUIDE
109 : *
109 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
110 : & 'POINT',I1,X1,' ',L1,IMOD)
111 : IF (IERR.NE.0) RETURN
111 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'COEFFICIENT_INERTIE',
112 : & L0,IP0,'FLOTTANT',I0,XINER,' ',L1,IP1)
113 : IF (IERR.NE.0) RETURN
113 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'COEFFICIENT_CONVECTION',
114 : & L0,IP0,'FLOTTANT',I0,XCONV,' ',L1,IP1)
115 : IF (IERR.NE.0) RETURN
115 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'COEFFICIENT_VISCOSITE',
116 : & L0,IP0,'FLOTTANT',I0,XVISC,' ',L1,IP1)
117 : IF (IERR.NE.0) RETURN
117 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,
118 : & 'COEFFICIENT_P_D_C_ELOIGNEMENT',L0,IP0,
119 : & 'FLOTTANT',I0,XPCEL,' ',L1,IP1)
120 : IF (IERR.NE.0) RETURN
120 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,
121 : & 'COEFFICIENT_P_D_C_RAPPROCHEMENT',L0,IP0,
122 : & 'FLOTTANT',I0,XPCRA,' ',L1,IP1)
123 : IF (IERR.NE.0) RETURN
123 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'JEU_FLUIDE',L0,IP0,
124 : & 'FLOTTANT',I0,XJEU,' ',L1,IP1)
125 : IF (IERR.NE.0) RETURN
126 : *
127 : IPALA(I,1) = 3
128 : XPALA(I,1) = XINER
129 : XPALA(I,2) = XCONV
130 : XPALA(I,3) = XVISC
131 : XPALA(I,4) = XPCEL
132 : XPALA(I,5) = XPCRA
133 : XPALA(I,6) = XJEU
134 : IK = ICPR(IMOD)
135 : IPLIA(I,1) = IK
136 : JPLIA(IK) = IMOD
137 : ELSE IF (CMOT(1:10).EQ.'POINT_PLAN') THEN
138 : MONAMO = ' '
138 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0,
139 : & MONAMO,I1,XAMO,CHARRE,L1,IP1)
140 : IF (IERR.NE.0) RETURN
141 : *
142 : * ------------ choc POINT_PLAN avec amortissement
143 : *
144 : IF (MONAMO.EQ.'FLOTTANT') THEN
144 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
145 : & 'POINT',I1,X1,' ',L1,IMOD)
146 : IF (IERR.NE.0) RETURN
146 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'RAIDEUR',L0,IP0,
147 : & 'FLOTTANT',I0,XRAID,' ',L1,IP1)
148 : IF (IERR.NE.0) RETURN
148 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'JEU',L0,IP0,
149 : & 'FLOTTANT',I0,XJEU,' ',L1,IP1)
150 : IF (IERR.NE.0) RETURN
151 : *
152 : IPALA(I,1) = 2
153 : XPALA(I,1) = XRAID
154 : XPALA(I,2) = XJEU
155 : XPALA(I,3) = XAMO
156 : IK = ICPR(IMOD)
157 : IPLIA(I,1) = IK
158 : JPLIA(IK) = IMOD
159 : *
160 : * ------------ choc POINT_PLAN sans amortissement
161 : *
162 : ELSE
162 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
163 : & 'POINT',I1,X1,' ',L1,IMOD)
164 : IF (IERR.NE.0) RETURN
164 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'RAIDEUR',L0,IP0,
165 : & 'FLOTTANT',I0,XRAID,' ',L1,IP1)
166 : IF (IERR.NE.0) RETURN
166 : CALL ACCTAB(ITLIAI,'MOT',I1,X0,'JEU',L0,IP0,
167 : & 'FLOTTANT',I0,XJEU,' ',L1,IP1)
168 : IF (IERR.NE.0) RETURN
169 : *
170 : IPALA(I,1) = 1
171 : XPALA(I,1) = XRAID
172 : XPALA(I,2) = XJEU
173 : IK = ICPR(IMOD)
174 : IPLIA(I,1) = IK
175 : JPLIA(IK) = IMOD
176 : ENDIF
177 : *
178 : * --------- liaison de couplage en vitesse
179 : *
180 : ELSE IF (CMOT(1:16).EQ.'COUPLAGE_VITESSE') THEN
180 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
181 : & 'POINT',I1,X1,' ',L1,ISUPP)
182 : IF (IERR.NE.0) RETURN
182 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'ORIGINE',L0,IP0,
183 : & 'POINT',I1,X1,' ',L1,IORIG)
184 : IF (IERR.NE.0) RETURN
184 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'COEFFICIENT',L0,IP0,
185 : & 'FLOTTANT',I1,XCPLGE,' ',L1,IP1)
186 : IF (IERR.NE.0) RETURN
187 : *
188 : IPALA(I,1) = 4
189 : XPALA(I,1) = XCPLGE
190 : IKX = ICPR(ISUPP)
191 : IPLIA(I,1) = IKX
192 : JPLIA(IKX) = ISUPP
193 : IKY = ICPR(IORIG)
194 : IPLIA(I,2) = IKY
195 : JPLIA(IKY) = IORIG
196 : *
197 : * --------- liaison de couplage en d{placement
198 : *
199 : ELSE IF (CMOT(1:20).EQ.'COUPLAGE_DEPLACEMENT') THEN
199 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
200 : & 'POINT',I1,X1,' ',L1,ISUPP)
201 : IF (IERR.NE.0) RETURN
201 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'ORIGINE',L0,IP0,
202 : & 'POINT',I1,X1,' ',L1,IORIG)
203 : IF (IERR.NE.0) RETURN
203 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'COEFFICIENT',L0,IP0,
204 : & 'FLOTTANT',I1,XCPLGE,' ',L1,IP1)
205 : IF (IERR.NE.0) RETURN
206 : *
207 : IPALA(I,1) = 5
208 : XPALA(I,1) = XCPLGE
209 : IKX = ICPR(ISUPP)
210 : IPLIA(I,1) = IKX
211 : JPLIA(IKX) = ISUPP
212 : IKY = ICPR(IORIG)
213 : IPLIA(I,2) = IKY
214 : JPLIA(IKY) = IORIG
215 : *
216 : * --------- liaison de type force POLYNOMIALE
217 : *
218 : ELSE IF (CMOT(1:11).EQ.'POLYNOMIALE') THEN
218 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0,
219 : & 'POINT',I1,X1,' ',L1,ISUPP)
220 : IF (IERR.NE.0) RETURN
220 : CALL ACCTAB(ITLIAI,'MOT',I0,X0,'COEFFICIENT',L0,IP0,
221 : & 'FLOTTANT',I1,XCOEF,' ',L1,IP1)
222 : IF (IERR.NE.0) RETURN
223 : * on met un flag reconnaissable ( cf dypol1) pour
224 : * reconnaissance du temps de demmarrage de la liaison
225 : do 101 ip = 1 , nxpala
226 : xpala(i,ip) = 123456.7
227 : 101 continue
228 :
229 : IPALA(I,1) = 6
230 : IKX = ICPR(ISUPP)
231 : IPLIA(I,1) = IKX
232 : JPLIA(IKX) = ISUPP
233 : XPALA(I,1) = XCOEF
234 : MTABLE = ITLIAI
235 : SEGACT MTABLE
236 : NIND1 = MLOTAB
237 : *
238 : * contributions des autres modes
239 : *
240 : K1 = 2
241 : K2 = 1
242 : if(nbesc.ne.0) segact ipiloc
243 : DO 20 J=1,NIND1
244 : * -- valeurs nulles par défaut
245 : XPALA(I,K1) = 0d0
246 : XPALA(I,K1+1) = 0d0
247 : XPALA(I,K1+2) = 0d0
248 : XPALA(I,K1+3) = 0d0
249 : XPALA(I,K1+4) = 0d0
250 : XPALA(I,K1+5) = 0d0
251 : TYPIND = MTABTI(J)
252 : IF (TYPIND.EQ.'POINT ') THEN
253 : TYPOBJ = MTABTV(J)
254 : IF (TYPOBJ.EQ.'TABLE ') THEN
255 : K2 = K2 + 1
256 : IORIG = MTABII(J)
257 : IKX = ICPR(IORIG)
258 : IPLIA(I,K2) = IKX
259 : JPLIA(IKX) = IORIG
260 : MTAB1 = MTABIV(J)
261 : SEGACT MTAB1
262 : NIND2 = MTAB1.MLOTAB
263 : RD = XZERO
264 : RV = XZERO
265 : DO 30 K=1,NIND2
266 : TYPIND = MTAB1.MTABTI(K)
267 : IF (TYPIND.EQ.'MOT ') THEN
268 : IP = MTAB1.MTABII(K)
269 : ID = IPCHAR(IP)
270 : IFI = IPCHAR(IP+1)
271 : IL1 = IFI - ID
272 : IF (IL1.EQ.20) THEN
273 : IF (CHAI1.EQ.ICHARA(ID:ID+19)) THEN
274 : TYPOBJ = MTAB1.MTABTV(K)
275 : IF (TYPOBJ.EQ.'FLOTTANT') THEN
276 : XPALA(I,K1) = MTAB1.RMTABV(K)
277 : ENDIF
278 : ENDIF
279 : ELSE IF (IL1.EQ.18) THEN
280 : IF (CHAI2.EQ.ICHARA(ID:ID+17)) THEN
281 : TYPOBJ = MTAB1.MTABTV(K)
282 : IF (TYPOBJ.EQ.'FLOTTANT') THEN
283 : RD = MTAB1.RMTABV(K)
284 : XPALA(I,K1+1) = RD
285 : ENDIF
286 : ENDIF
287 : ELSE IF (IL1.EQ.15) THEN
288 : IF (CHAI3.EQ.ICHARA(ID:ID+14)) THEN
289 : TYPOBJ = MTAB1.MTABTV(K)
290 : IF (TYPOBJ.EQ.'FLOTTANT') THEN
291 : XPALA(I,K1+2) = MTAB1.RMTABV(K)
292 : ENDIF
293 : ENDIF
294 : ELSE IF (IL1.EQ.16) THEN
295 : IF (CHAI4.EQ.ICHARA(ID:ID+15)) THEN
296 : TYPOBJ = MTAB1.MTABTV(K)
297 : IF (TYPOBJ.EQ.'FLOTTANT') THEN
298 : XPALA(I,K1+3) = MTAB1.RMTABV(K)
299 : ENDIF
300 : ENDIF
301 : ELSE IF (IL1.EQ.14) THEN
302 : IF (CHAI5.EQ.ICHARA(ID:ID+13)) THEN
303 : TYPOBJ = MTAB1.MTABTV(K)
304 : IF (TYPOBJ.EQ.'FLOTTANT') THEN
305 : RV = MTAB1.RMTABV(K)
306 : XPALA(I,K1+4) = RV
307 : ENDIF
308 : ENDIF
309 : ELSE IF (IL1.EQ.11) THEN
310 : IF (CHAI6.EQ.ICHARA(ID:ID+10)) THEN
311 : TYPOBJ = MTAB1.MTABTV(K)
312 : IF (TYPOBJ.EQ.'FLOTTANT') THEN
313 : XPALA(I,K1+5) = MTAB1.RMTABV(K)
314 : ENDIF
315 : ENDIF
316 : ENDIF
317 : ENDIF
318 : 30 CONTINUE
319 : ND = INT(RD/XPDTS2) + 1
320 : NV = INT(RV/XPDTS2) + 2
321 : NMAX = MAX(ND,NV)
322 : K1 = K1 + 6 + NMAX
323 : ENDIF
324 : ENDIF
325 : 20 CONTINUE
326 : if(nbesc.ne.0)segdes ipiloc
327 : SEGDES MTABLE
328 : *
329 : * Nombre de modes "origine"
330 : *
331 : IPALA(I,2) = K2 - 1
332 : *
333 : * --------- choc ...........
334 : *
335 : * ELSE IF (CMOT(1: ).EQ.' ') THEN
336 : * .......
337 : * .......
338 : *
339 : ELSE
339 : CALL ERREUR(490)
340 : RETURN
341 : ENDIF
342 : *
343 : * Liaison ...........
344 : *
345 : * ELSE IF (MONMOT(1: ).EQ.' ') THEN
346 : * .......
347 : * .......
348 : *
349 : ELSE
349 : CALL ERREUR(489)
350 : RETURN
351 : ENDIF
352 : 10 CONTINUE
353 : *
354 : *
355 : *
356 : * ----- liaisons conditionnelles ?
357 : *
358 : *
359 : DO 11 I = 1,NLIAA
360 : ksi = 0
360 : CALL ACCTAB(ILIA,'ENTIER',I,X0,' ',L0,IP0,
361 : & 'TABLE',I0,X0,' ',L1,ITLIAI)
362 :
363 : DO 111 j = 1,NLIAA
364 : jtliai = icorres ( j )
365 : monmot = ' '
365 : CALL ACCTAB(ITLIAI,'TABLE',I0,x0,' ',L0,jtliai,
366 : & monmot,I1,X0,CHARRE,L1,IP1)
367 : IF (IERR.NE.0) RETURN
368 : * ------- si on trouve un logique en face d'une table
369 : * de liaison , c'est bon
370 : IF (MONMOT.EQ.'LOGIQUE ') THEN
371 : ksi = ksi + 1
372 : ipala(i,2) = 1
373 : IF (L1 ) tHEN
374 : ipala (i,3+ksi) = j
375 : ELSE IF (.NOT. L1) THEN
376 : ipala (i,3+ksi) = -1 * j
377 : ENDIF
378 : ENDIF
379 : 111 CONTINUE
380 : 11 CONTINUE
381 : *
382 : *
383 : *
384 : *
385 : * end do
386 : IF (IIMPI.EQ.333) THEN
387 : DO 1000 IN = 1,NLIAA
388 : DO 1002 II = 1,NIPALA
389 : WRITE(IOIMP,*)'DYNE19 : IPALA(',IN,',',II,') =',IPALA(IN,II)
390 : 1002 CONTINUE
391 : DO 1004 IX = 1,NXPALA
392 : WRITE(IOIMP,*)'DYNE19 : XPALA(',IN,',',IX,') =',XPALA(IN,IX)
393 : 1004 CONTINUE
394 : DO 1006 IP = 1,NPLAA
395 : WRITE(IOIMP,*)'DYNE19 : IPLIA(',IN,',',IP,') =',IPLIA(IN,IP)
396 : 1006 CONTINUE
397 : 1000 CONTINUE
398 : DO 1008 IP = 1,NPLA
399 : WRITE(IOIMP,*)'DYNE19 : JPLIA(',IP,') =',JPLIA(IP)
400 : 1008 CONTINUE
401 : ENDIF
402 : *
403 : END
404 :
405 :
406 :
© Cast3M 2003 - All rights reserved.
Disclaimer