1 : C DYNE17 SOURCE KICH 09/11/27 21:16:11 6552
2 : SUBROUTINE DYNE17(ITBAS,ITKM,IPMAIL,KTRES,KPREF,NPLAA,NXPALA,
3 : &KSAM,lmodyn)
4 : IMPLICIT INTEGER(I-N)
5 : IMPLICIT REAL*8(A-H,O-Z)
6 : *--------------------------------------------------------------------*
7 : * *
8 : * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
9 : * ________________________________________________ *
10 : * *
11 : * Cr{ation des CHPOINTs qui contiendront les r{sultats. *
12 : * Cr{ation des LISTREELs qui contiendront les r{sultats. *
13 : * Cr{ation des POINTS qui contiendront les varaibles de liaison *
14 : * n{cessaires @ une reprise. *
15 : * *
16 : * Param}tres: *
17 : * *
18 : * e ITBAS Table repr{sentant une base modale *
19 : * e ITKM Table contenant les matrices XK et XM *
20 : * e IPMAIL Maillage de r{f{rence *
21 : * es KTRES Segment de sauvegarde des r{sultats *
22 : * e KPREF Segment des points de r{f{rence *
23 : * e NPLAA Nombre max de pts pour les liaisons en base A *
24 : * e NXPALA Nombre max de var internes pour ces memes liaisons *
25 : * *
26 : * Remarque importante: tous les CHPOINTs cr{{s vont pointer *
27 : * sur le mªme MELEME afin de limiter au maximum la m{moire *
28 : * utilis{e. *
29 : * *
30 : * Auteur, date de cr{ation: *
31 : * *
32 : * Denis ROBERT-MOUGIN, le 30 juin 1989. *
33 : * *
34 : *--------------------------------------------------------------------*
35 : -INC CCOPTIO
36 : -INC SMCHARG
37 : -INC SMCHPOI
38 : -INC SMELEME
39 : -INC SMRIGID
40 : -INC SMLREEL
41 : -INC SMLENTI
42 : -INC SMCOORD
43 : -INC SMTABLE
44 : *
45 : * IPORES contient les pointeurs sur les CHPOINTs qui
46 : * repr{senteront chaque variable pour chaque pas de sortie.
47 : * IPOREP contient les pointeurs sur les CHPOINTs
48 : * n{cessaires @ une reprise {ventuelle de calcul.
49 : *
50 : SEGMENT,MTRES
51 : REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES)
52 : REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB)
53 : REAL*8 XMREP(NLIAB,4,IDIMB)
54 : INTEGER ICHRES(NVES),IPORES(NRES,NPRES),IPOREP(NREP)
55 : INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA)
56 : INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB)
57 : INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR)
58 : INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR)
59 : INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4)
60 : INTEGER ILPOLA(NLIAA,2)
61 : ENDSEGMENT
62 : SEGMENT,MPREF
63 : INTEGER IPOREF(NPREF)
64 : ENDSEGMENT
65 : * Segment pour Champoints
66 : SEGMENT,MSAM
67 : integer jplibb(NPLB)
68 : ENDSEGMENT
69 : *
70 : LOGICAL L0,L1,lmodyn
71 : *
72 : MTRES = KTRES
73 : MPREF = KPREF
74 : MSAM =KSAM
75 : NPREF = IPOREF(/1)
76 : NRES = XRES(/1)
77 : NVES = ICHRES(/1)
78 : NCRES = XRES(/1)
79 : NPRES = XRES(/3)
80 : NREP = XREP(/1)
81 : NLSA = IPLRLA(/1)
82 : NLSB = IPLRLB(/1)
83 : NLIAB = XMREP(/1)
84 : NLIAA = ILPOLA(/1)
85 : NPLBB=JPLIBB(/1)
86 : NTVAR = ILIRNB(/2)
87 : *
88 : IF (ITBAS.NE.0.AND.ITKM.EQ.0) THEN
89 : IF(LMODYN) THEN
90 : meleme = ipmail
91 : segact meleme
92 : if (lisous(/1).eq.0) then
93 : ipmmod = ipmail
94 : ipmsta = 0
95 : else
96 : ipmmod = lisous(1)
97 : ipmsta = lisous(2)
98 : endif
99 : *
100 : * production chpoint forces base A (devso2)
101 : *
102 : NSOUPO = 1
103 : if(ipmmod.gt.0.and.ipmsta.gt.0) nsoupo = 2
104 : NAT=1
105 : SEGINI,MCHPOI
106 : IPCHPO = MCHPOI
107 : MTYPOI = 'FLIAISONS'
108 : IFOPOI = IFOUR
109 : * nature diffuse
110 : JATTRI(1) = 1
111 : nmost0 = 0
112 : KIPCHP = 0
113 : if (ipmmod.gt.0) then
114 : NC = 1
115 : SEGINI,MSOUPO
116 : KIPCHP = KIPCHP + 1
117 : IPCHP(KIPCHP) = MSOUPO
118 : NOCOMP(1) = 'ALFA'
119 : NOHARM(1) = NIFOUR
120 : IGEOC = ipmmod
121 : ipt1 = ipmmod
122 : segact ipt1
123 : N = ipt1.num(/2)
124 : nmost0 = N
125 : SEGINI,MPOVAL
126 : IPOVAL = MPOVAL
127 : endif
128 :
129 : if (ipmsta.gt.0) then
130 : NC = 1
131 : SEGINI,MSOUPO
132 : KIPCHP = KIPCHP + 1
133 : IPCHP(KIPCHP) = MSOUPO
134 : NOCOMP(1) = 'BETA'
135 : NOHARM(1) = NIFOUR
136 : IGEOC = ipmsta
137 : ipt1 = ipmsta
138 : segact ipt1
139 : N = ipt1.num(/2)
140 : SEGINI,MPOVAL
141 : IPOVAL = MPOVAL
142 : endif
143 :
144 : ELSE
145 : *
146 : * Cas de la base modale, on n'a qu'une composante: 'ALFA'
147 : *
148 : IF (IIMPI.EQ.333) THEN
149 : WRITE(IOIMP,*)'DYNE17: cas de la base modale'
150 : ENDIF
151 : NSOUPO = 1
152 : NAT=1
153 : SEGINI,MCHPOI
154 : IPCHPO = MCHPOI
155 : MTYPOI = ' '
156 : IFOPOI = IFOUR
157 : * nature diffuse
158 : JATTRI(1) = 1
159 : NC = 1
160 : SEGINI,MSOUPO
161 : IPCHP(1) = MSOUPO
162 : NOCOMP(1) = 'ALFA'
163 : NOHARM(1) = NIFOUR
164 : NOCOMP(1) = 'ALFA'
165 : NOHARM(1) = NIFOUR
166 : IGEOC = IPMAIL
167 : N = NPREF
168 : SEGINI,MPOVAL
169 : IPOVAL = MPOVAL
170 :
171 : ENDIF
172 :
173 : ELSE IF (ITKM.NE.0) THEN
174 : *
175 : * On se r{f}re au descripteur de la rigidit{, mais attention:
176 : * les composantes peuvent diff{rer d'une zone {l{mentaire @
177 : * une autre.
178 : *
178 : CALL ACCTAB(ITKM,'MOT',I0,X0,'RAIDEUR',L0,IP0,
179 : & 'RIGIDITE',I1,X1,' ',L1,IRIGI)
180 : *
181 : * Cr{ation du CHPOINT de r{f{rence:
182 : *
183 : IF (IIMPI.EQ.333) THEN
184 : WRITE(IOIMP,*)
185 : & 'DYNE17: cr{ation selon un descripteur de rigidit{'
186 : ENDIF
187 : MRIGID = IRIGI
188 : SEGACT,MRIGID
189 : NRIGI = IRIGEL(/2)
190 : IF (IIMPI.EQ.333) THEN
191 : WRITE(IOIMP,*)
192 : & 'DYNE17: nombre de rigidit{s {l{mentaires ',NRIGI
193 : ENDIF
194 : NSOUPO = NRIGI
195 : NAT=1
196 : SEGINI,MCHPOI
197 : IPCHPO = MCHPOI
198 : MTYPOI = ' '
199 : * nature diffuse
200 : JATTRI(1) = 1
201 : IFOPOI = IFOUR
202 : DO 30 I=1,NRIGI
203 : NYSONT = 0
204 : DESCR = IRIGEL(3,I)
205 : IPT1 = IRIGEL(1,I)
206 : SEGACT,DESCR,IPT1
207 : *
208 : * NTOTC est le nombre total d'inconnues
209 : * NBNO est le nombre de noeuds par {l{ment
210 : * NBELEM est le nombre d'{l{ments dans la zone
211 : * NC est le nombre de composantes par noeud dans la zone
212 : *
213 : NBNO = IPT1.NUM(/1)
214 : NBELEM = IPT1.NUM(/2)
215 : NTOTC = LISINC(/2)
216 : NC = NTOTC / NBNO
217 : IF (IIMPI.EQ.333) THEN
218 : WRITE(IOIMP,*)'DYNE17: nombre total d''inconnues ',NTOTC
219 : WRITE(IOIMP,*)'DYNE17: nombre de noeuds par {l{ment ',NBNO
220 : WRITE(IOIMP,*)'DYNE17: nombre d''{l{ments dans la zone ',NBELEM
221 : WRITE(IOIMP,*)'DYNE17: nombre de composantes par noeud ',NC
222 : ENDIF
223 : SEGINI,MSOUPO
224 : IPCHP(I) = MSOUPO
225 : IGEOC = IPT1
226 : DO 40 IC=1,NC
227 : NOCOMP(IC) = LISINC(IC)
228 : NOHARM(IC) = NIFOUR
229 : 40 CONTINUE
230 : * end do
231 : *
232 : * Combien de noeuds r{f{renc{s dans cette zone ?
233 : *
234 : DO 50 IEL=1,NBELEM
235 : DO 50 INO=1,NBNO
235 : CALL PLACE2(IPOREF,NPREF,ILYEST,IPT1.NUM(INO,IEL))
236 : IF (ILYEST.NE.0) NYSONT = NYSONT + 1
237 : 50 CONTINUE
238 : * end do
239 : IF (IIMPI.EQ.333) THEN
240 : WRITE(IOIMP,*)'DYNE17: nombre de noeuds dans la zone ',NYSONT
241 : ENDIF
242 : N = NYSONT
243 : SEGINI,MPOVAL
244 : IPOVAL = MPOVAL
245 : SEGDES,DESCR,IPT1
246 : 30 CONTINUE
247 : * end do
248 : SEGDES,MRIGID
249 : ENDIF
250 : *
251 : * Duplication du CHPOINT pour les variables demand{es,
252 : * @ tous les pas de sortie:
253 : *
254 : II = 0
255 : DO 60 ICR=1,8
256 : IF (ICHRES(ICR).EQ.1) THEN
257 : II = II + 1
258 : DO 70 IPAS=1,NPRES
258 : CALL COPIE5(IPCHPO,IPCHP1)
259 : IPORES(II,IPAS) = IPCHP1
260 : 70 CONTINUE
261 : * end do
262 : ENDIF
263 : 60 CONTINUE
264 : * end do
265 : *
266 : * Cas des CHPOINTs n{cessaires @ la reprise du calcul:
267 : *
268 : DO 80 I = 1,NREP
268 : CALL COPIE5(IPCHPO,IPCHP1)
269 : IPOREP(I) = IPCHP1
270 : 80 CONTINUE
271 : * end do
272 : *
273 : * Cas des POINTS n{cessaires @ la reprise du calcul:
274 : *
275 : IDIM1 = IDIM + 1
276 : NPTS = XCOOR(/1) / IDIM1
277 : NBPTS = NPTS + 4 * NLIAB
278 : SEGADJ MCOORD
279 : DO 90 I = 1,NLIAB
280 : DO 90 II = 1,4
281 : NPTS = NPTS + 1
282 : IPPREP(I,II) = NPTS
283 : 90 CONTINUE
284 : * end do
285 : *
286 : MCHPOI = IPCHPO
287 : SEGSUP,MCHPOI
288 : *
289 : * Cr{ation des LISTREELs qui contiendront les r{sultats
290 : *
291 : JG = NPRES
292 : SEGINI,MLREEL
293 : IPOLR(1) = MLREEL
294 : *
295 : DO 100 IL = 1,NLSA
296 : NLR = ICHRES(10 + IL)
297 : DO 105 IN = 1,NLR
298 : JG = NPRES
299 : SEGINI,MLREEL
300 : IPLRLA(IL,IN) = MLREEL
301 : 105 CONTINUE
302 : * end do
303 : 100 CONTINUE
304 : * end do
305 : * DO 110 IL = 1,NLSB
306 : * NLR = ICHRES(10 + NLSA + IL)
307 : * DO 115 IN = 1,NLR
308 : * JG = NPRES
309 : * SEGINI,MLREEL
310 : * IPLRLB(IL,IN) = MLREEL
311 : * 115 CONTINUE
312 : * end do
313 : * 110 CONTINUE
314 : * end do
315 : *
316 : * Creation des LISTENTIs et des LISTREELs pour sauvegarde
317 : * des liaisons POLYNOMIALEs en base A en vue d'une reprise
318 : *
319 : DO 200 I = 1,NLIAA
320 : IF (ILPOLA(I,1).EQ.1) THEN
321 : JG = NPLAA * 2
322 : SEGINI,MLENTI
323 : ILPOLA(I,1) = MLENTI
324 : JG = NXPALA
325 : SEGINI,MLREEL
326 : ILPOLA(I,2) = MLREEL
327 : ENDIF
328 : 200 CONTINUE
329 : *
330 : DO 300 IL=1,NLSB
331 : II=0
332 : DO 310 IV = 1,NTVAR
333 : IF (ILIREB(IL,IV).EQ.1) THEN
334 : II=II+1
335 : JG = NPRES
336 : SEGINI,MLREEL
337 : IPLRLB(IL,II) = MLREEL
338 : ELSE
339 : IF (ILIREB(IL,IV).EQ.2) THEN
340 : M=NPRES
341 : SEGINI,MTABLE
342 : MLOTAB=M
343 : DO 320 IM=1,NPRES
344 : MTABTI(IM)='ENTIER'
345 : MTABTV(IM)='CHPOINT'
346 : MTABII(IM)=IM
347 : 320 CONTINUE
348 : SEGDES,MTABLE
349 : IPLRLB(IL,II+1)=MTABLE
350 : * Création d un champoint
351 : NSOUPO=1
352 : SEGINI,MCHPOI
353 : IPCHPO = MCHPOI
354 : MOCHDE = 'Force_de_choc'
355 : * nature diffuse
356 : NC=2
357 : SEGINI,MSOUPO
358 : NOCOMP(1)='NORM'
359 : NOCOMP(2)='TANG'
360 : IPCHP(1)=MSOUPO
361 : N=NPLBB
362 : SEGINI,MPOVAL
363 : IPOVAL=MPOVAL
364 : NBELEM=NPLBB
365 : NBNN=1
366 : NBREF=0
367 : NBSOUS=0
368 : SEGINI,MELEME
369 : DO 330 IE=1,NPLBB
370 : NUM(1,IE)=JPLIBB(IE)
371 : 330 CONTINUE
372 : IGEOC=MELEME
373 : JG=NPRES
374 : SEGINI,MLENTI
375 : DO 340 I = 1,NPRES
375 : CALL COPIE5(IPCHPO,IPCHP1)
376 : LECT(I) = IPCHP1
377 : 340 CONTINUE
378 : SEGDES,MLENTI
379 : IPLRLB(IL,II+2)=MLENTI
380 : MCHPOI=IPCHPO
381 : SEGSUP,MCHPOI
382 : *
383 : II=II+NPLBB*2
384 : ENDIF
385 : ENDIF
386 : 310 CONTINUE
387 : 300 CONTINUE
388 : * end do
389 : *
390 : END
391 :
392 :
393 :
394 :
395 :
396 :
397 :
398 :
399 :
400 :
401 :
402 :
© Cast3M 2003 - All rights reserved.
Disclaimer