OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2for3p.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23C dev023 routine duale de i2for3 pour parith/on spmd
24!||====================================================================
25!|| i2for3pn ../engine/source/interfaces/interf/i2for3p.f
26!||--- called by ------------------------------------------------------
27!|| intti2f ../engine/source/interfaces/interf/intti2f.F
28!||--- calls -----------------------------------------------------
29!|| i2forces ../engine/source/interfaces/interf/i2forces.F
30!|| i2forces_2d ../engine/source/interfaces/interf/i2forces_2D.F
31!||--- uses -----------------------------------------------------
32!|| h3d_mod ../engine/share/modules/h3d_mod.F
33!||====================================================================
34 SUBROUTINE i2for3pn(NSN ,NMN ,A ,CRST ,NSV ,
35 2 MS ,WEIGHT ,STIFN ,MMASS ,FSKYI2 ,
36 3 IADI2 ,I0 ,NIR ,I2SIZE ,IDEL2 ,
37 4 SMASS ,IRECT ,X ,V ,FSAV ,
38 5 FNCONT ,IRTL ,H3D_DATA, CSTS_BIS,FNCONTP ,
39 6 FTCONTP)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE h3d_mod
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER NSN, NMN, I0, NIR, I2SIZE, IDEL2,
52 . IRECT(4,*),IADI2(NIR,*), NSV(*), WEIGHT(*), IRTL(*)
53C REAL
54 my_real
55 . X(*),V(*),A(*), CRST(2,*), MS(*), STIFN(*), MMASS(*),
56 . fskyi2(i2size,*), smass(*),fsav(*),fncont(3,*),csts_bis(2,*),
57 . fncontp(3,*) ,ftcontp(3,*)
58 TYPE (H3D_DATABASE) :: H3D_DATA
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com01_c.inc"
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I, I1, I2, I3, II, NN, L, J, JJ
67C REAL
68 my_real
69 . SS, ST, XMSI, FS(3),SP,SM,TP,TM,
70 . H(4),H2(4),FX(4),FY(4),FZ(4)
71C-----------------------------------------------
72 IF (nir==2) THEN
73 DO ii=1,nsn
74 i=nsv(ii)
75 IF(i>0)THEN
76 l=irtl(ii)
77 i3=3*i
78 i2=i3-1
79 i1=i2-1
80C traitement 1er noeud secnd
81 IF (weight(i)==1) THEN
82C
83 xmsi=ms(i)
84 fs(1)=a(i1)
85 fs(2)=a(i2)
86 fs(3)=a(i3)
87C
88 ss=crst(1,ii)
89 st=crst(2,ii)
90 sp=one + ss
91 sm=one - ss
92 tp=fourth*(one + st)
93 tm=fourth*(one - st)
94 h(1)=tm*sm
95 h(2)=tm*sp
96C Additional shape functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
97 ss=csts_bis(1,ii)
98 st=csts_bis(2,ii)
99 sp=one + ss
100 sm=one - ss
101 tp=fourth*(one + st)
102 tm=fourth*(one - st)
103 h2(1)=tm*sm
104 h2(2)=tm*sp
105 h2(3)=tp*sp
106 h2(4)=tp*sm
107C
108 fx(1:2) = fs(1)*h(1:2)
109 fy(1:2) = fs(2)*h(1:2)
110 fz(1:2) = fs(3)*h(1:2)
111 fx(3:4) = zero
112 fy(3:4) = zero
113 fz(3:4) = zero
114C
115 i0 = i0 + 1
116 nn = iadi2(1,i0)
117 fskyi2(1,nn) = fx(1)
118 fskyi2(2,nn) = fy(1)
119 fskyi2(3,nn) = fz(1)
120 fskyi2(4,nn) = xmsi*h2(1)
121 fskyi2(5,nn) = abs(stifn(i)*h(1))
122C
123 nn = iadi2(2,i0)
124 fskyi2(1,nn) = fx(2)
125 fskyi2(2,nn) = fy(2)
126 fskyi2(3,nn) = fz(2)
127 fskyi2(4,nn) = xmsi*h2(2)
128 fskyi2(5,nn) = abs(stifn(i)*h(2))
129 ENDIF
130C--- output of tied contact forces
131 CALL i2forces_2d(x ,fs ,fx ,fy ,fz ,
132 . irect(1,l),nir ,fsav ,fncont ,fncontp,
133 . ftcontp ,weight ,h3d_data,i ,h)
134c
135 stifn(i)=em20
136 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
137 ms(i)=zero
138 a(i1)=zero
139 a(i2)=zero
140 a(i3)=zero
141C stokage ZERO pour noeuds delete par idel2
142 ELSEIF(weight(-i)==1) THEN
143 i0 = i0 + 1
144 nn = iadi2(1,i0)
145 fskyi2(1,nn) = zero
146 fskyi2(2,nn) = zero
147 fskyi2(3,nn) = zero
148 fskyi2(4,nn) = zero
149 fskyi2(5,nn) = zero
150 nn = iadi2(2,i0)
151 fskyi2(1,nn) = zero
152 fskyi2(2,nn) = zero
153 fskyi2(3,nn) = zero
154 fskyi2(4,nn) = zero
155 fskyi2(5,nn) = zero
156 ENDIF
157 ENDDO
158C NIR = 4
159 ELSE
160 DO ii=1,nsn
161 i=nsv(ii)
162 IF(i>0)THEN
163 l=irtl(ii)
164 i3=3*i
165 i2=i3-1
166 i1=i2-1
167C traitement 1er noeud secnd
168 IF (weight(i)==1) THEN
169C
170 xmsi=ms(i)
171 fs(1)=a(i1)
172 fs(2)=a(i2)
173 fs(3)=a(i3)
174C
175 ss=crst(1,ii)
176 st=crst(2,ii)
177 sp=one + ss
178 sm=one - ss
179 tp=fourth*(one + st)
180 tm=fourth*(one - st)
181 h(1)=tm*sm
182 h(2)=tm*sp
183 h(3)=tp*sp
184 h(4)=tp*sm
185
186C Additional shape functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
187 ss=csts_bis(1,ii)
188 st=csts_bis(2,ii)
189 sp=one + ss
190 sm=one - ss
191 tp=fourth*(one + st)
192 tm=fourth*(one - st)
193 h2(1)=tm*sm
194 h2(2)=tm*sp
195 h2(3)=tp*sp
196 h2(4)=tp*sm
197C
198 fx(1:4) = fs(1)*h(1:4)
199 fy(1:4) = fs(2)*h(1:4)
200 fz(1:4) = fs(3)*h(1:4)
201C
202 i0 = i0 + 1
203 nn = iadi2(1,i0)
204 fskyi2(1,nn) = fx(1)
205 fskyi2(2,nn) = fy(1)
206 fskyi2(3,nn) = fz(1)
207 fskyi2(4,nn) = xmsi*h2(1)
208 fskyi2(5,nn) = abs(stifn(i)*h(1))
209C
210 nn = iadi2(2,i0)
211 fskyi2(1,nn) = fx(2)
212 fskyi2(2,nn) = fy(2)
213 fskyi2(3,nn) = fz(2)
214 fskyi2(4,nn) = xmsi*h2(2)
215 fskyi2(5,nn) = abs(stifn(i)*h(2))
216C
217 nn = iadi2(3,i0)
218 fskyi2(1,nn) = fx(3)
219 fskyi2(2,nn) = fy(3)
220 fskyi2(3,nn) = fz(3)
221 fskyi2(4,nn) = xmsi*h2(3)
222 fskyi2(5,nn) = abs(stifn(i)*h(3))
223C
224 nn = iadi2(4,i0)
225 fskyi2(1,nn) = fx(4)
226 fskyi2(2,nn) = fy(4)
227 fskyi2(3,nn) = fz(4)
228 fskyi2(4,nn) = xmsi*h2(4)
229 fskyi2(5,nn) = abs(stifn(i)*h(4))
230 ENDIF
231C
232C--- output of tied contact forces
233 CALL i2forces(x ,fs ,fx ,fy ,fz ,
234 . irect(1,l),nir ,fsav ,fncont ,fncontp,
235 . ftcontp ,weight ,h3d_data,i ,h)
236C
237 IF(iroddl==0)THEN
238 stifn(i)=em20
239 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
240 ms(i)=zero
241 a(i1)=zero
242 a(i2)=zero
243 a(i3)=zero
244 ENDIF
245
246C stokage ZERO pour noeuds delete par idel2
247 ELSEIF(weight(-i)==1) THEN
248 i0 = i0 + 1
249 nn = iadi2(1,i0)
250 fskyi2(1,nn) = zero
251 fskyi2(2,nn) = zero
252 fskyi2(3,nn) = zero
253 fskyi2(4,nn) = zero
254 fskyi2(5,nn) = zero
255 nn = iadi2(2,i0)
256 fskyi2(1,nn) = zero
257 fskyi2(2,nn) = zero
258 fskyi2(3,nn) = zero
259 fskyi2(4,nn) = zero
260 fskyi2(5,nn) = zero
261 nn = iadi2(3,i0)
262 fskyi2(1,nn) = zero
263 fskyi2(2,nn) = zero
264 fskyi2(3,nn) = zero
265 fskyi2(4,nn) = zero
266 fskyi2(5,nn) = zero
267 nn = iadi2(4,i0)
268 fskyi2(1,nn) = zero
269 fskyi2(2,nn) = zero
270 fskyi2(3,nn) = zero
271 fskyi2(4,nn) = zero
272 fskyi2(5,nn) = zero
273 ENDIF
274C----
275C----
276 ENDDO
277 ENDIF
278C
279 RETURN
280 END
281!||====================================================================
282!|| i2for3p ../engine/source/interfaces/interf/i2for3p.F
283!||--- called by ------------------------------------------------------
284!|| intti2f ../engine/source/interfaces/interf/intti2f.F
285!||--- calls -----------------------------------------------------
286!|| i2forces ../engine/source/interfaces/interf/i2forces.F
287!||--- uses -----------------------------------------------------
288!|| h3d_mod ../engine/share/modules/h3d_mod.F
289!||====================================================================
290 SUBROUTINE i2for3p(NSN ,NMN ,A ,CRST ,MSR ,
291 2 NSV ,MS ,WEIGHT ,STIFN ,MMASS ,
292 3 FSKYI2 ,IADI2 ,I0 ,NIR ,I2SIZE ,
293 4 IRECT ,X ,V ,FSAV ,FNCONT ,
294 5 IRTL ,H3D_DATA, CSTS_BIS,FNCONTP,FTCONTP)
295C-----------------------------------------------
296C M o d u l e s
297C-----------------------------------------------
298 USE h3d_mod
299C-----------------------------------------------
300C I m p l i c i t T y p e s
301C-----------------------------------------------
302#include "implicit_f.inc"
303C-----------------------------------------------
304C D u m m y A r g u m e n t s
305C-----------------------------------------------
306 INTEGER NSN, NMN, I0, NIR, I2SIZE,
307 . irect(4,*),iadi2(nir,*),
308 . msr(*), nsv(*), weight(*), irtl(*)
309C REAL
310 my_real
311 . x(*),v(*),a(*),crst(2,*),ms(*),stifn(*), mmass(*),fsav(*),
312 . fskyi2(i2size,*),fncont(3,*), csts_bis(2,*),
313 . fncontp(3,*),ftcontp(3,*)
314 TYPE (H3D_DATABASE) :: H3D_DATA
315C-----------------------------------------------
316C C o m m o n B l o c k s
317C-----------------------------------------------
318#include "com01_c.inc"
319C-----------------------------------------------
320C L o c a l V a r i a b l e s
321C-----------------------------------------------
322 INTEGER I, J, I1, I2, I3, II, JJ, NN, L
323C REAL
324 my_real
325 . h(4),
326 . ss, st, xmsi, fs(3),sp,sm,tp,tm,h2(4),
327 . fx(4),fy(4),fz(4)
328C=======================================================================
329 l = 0
330C sauvegarde de la masse initiale
331 DO ii=1,nmn
332 j=msr(ii)
333 mmass(ii)=ms(j)
334 ENDDO
335C
336 IF (nir==2) THEN
337 DO ii=1,nsn
338 i=nsv(ii)
339 IF(i>0) THEN
340 l=irtl(ii)
341 i3=3*i
342 i2=i3-1
343 i1=i2-1
344C traitement 1er noeud secnd
345 IF (weight(i)==1) THEN
346C
347 ss=crst(1,ii)
348 st=crst(2,ii)
349C
350 xmsi=ms(i)
351 fs(1)=a(i1)
352 fs(2)=a(i2)
353 fs(3)=a(i3)
354C
355 sp=one + ss
356 sm=one - ss
357 tp=fourth*(one + st)
358 tm=fourth*(one - st)
359 h(1)=tm*sm
360 h(2)=tm*sp
361C
362 fx(1:2) = fs(1)*h(1:2)
363 fy(1:2) = fs(2)*h(1:2)
364 fz(1:2) = fs(3)*h(1:2)
365 fx(3:4) = zero
366 fy(3:4) = zero
367 fz(3:4) = zero
368C
369 i0 = i0 + 1
370 nn = iadi2(1,i0)
371 fskyi2(1,nn) = fx(1)
372 fskyi2(2,nn) = fy(1)
373 fskyi2(3,nn) = fz(1)
374 fskyi2(4,nn) = xmsi*h(1)
375 fskyi2(5,nn) = abs(stifn(i)*h(1))
376C
377 nn = iadi2(2,i0)
378 fskyi2(1,nn) = fx(2)
379 fskyi2(2,nn) = fy(2)
380 fskyi2(3,nn) = fz(2)
381 fskyi2(4,nn) = xmsi*h(2)
382 fskyi2(5,nn) = abs(stifn(i)*h(2))
383 ENDIF
384 stifn(i)=em20
385 a(i1)=zero
386 a(i2)=zero
387 a(i3)=zero
388 ELSEIF(weight(-i)==1) THEN
389 i0 = i0 + 1
390 nn = iadi2(1,i0)
391 fskyi2(1,nn) = zero
392 fskyi2(2,nn) = zero
393 fskyi2(3,nn) = zero
394 fskyi2(4,nn) = zero
395 fskyi2(5,nn) = zero
396 nn = iadi2(2,i0)
397 fskyi2(1,nn) = zero
398 fskyi2(2,nn) = zero
399 fskyi2(3,nn) = zero
400 fskyi2(4,nn) = zero
401 fskyi2(5,nn) = zero
402 END IF
403 ENDDO
404C NIR = 4
405 ELSE
406 DO ii=1,nsn
407 i=nsv(ii)
408 IF(i>0)THEN
409 l=irtl(ii)
410 i3=3*i
411 i2=i3-1
412 i1=i2-1
413C traitement 1er noeud secnd
414 IF (weight(i)==1) THEN
415C
416 xmsi=ms(i)
417 fs(1)=a(i1)
418 fs(2)=a(i2)
419 fs(3)=a(i3)
420C
421 ss=crst(1,ii)
422 st=crst(2,ii)
423 sp=one + ss
424 sm=one - ss
425 tp=fourth*(one + st)
426 tm=fourth*(one - st)
427 h(1)=tm*sm
428 h(2)=tm*sp
429 h(3)=tp*sp
430 h(4)=tp*sm
431
432C Additional shape functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
433 ss=csts_bis(1,ii)
434 st=csts_bis(2,ii)
435 sp=one + ss
436 sm=one - ss
437 tp=fourth*(one + st)
438 tm=fourth*(one - st)
439 h2(1)=tm*sm
440 h2(2)=tm*sp
441 h2(3)=tp*sp
442 h2(4)=tp*sm
443C
444 fx(1:4) = fs(1)*h(1:4)
445 fy(1:4) = fs(2)*h(1:4)
446 fz(1:4) = fs(3)*h(1:4)
447C
448 i0 = i0 + 1
449 nn = iadi2(1,i0)
450 fskyi2(1,nn) = fx(1)
451 fskyi2(2,nn) = fy(1)
452 fskyi2(3,nn) = fz(1)
453 fskyi2(4,nn) = xmsi*h2(1)
454 fskyi2(5,nn) = abs(stifn(i)*h(1))
455C
456 nn = iadi2(2,i0)
457 fskyi2(1,nn) = fx(2)
458 fskyi2(2,nn) = fy(2)
459 fskyi2(3,nn) = fz(2)
460 fskyi2(4,nn) = xmsi*h2(2)
461 fskyi2(5,nn) = abs(stifn(i)*h(2))
462C
463 nn = iadi2(3,i0)
464 fskyi2(1,nn) = fx(3)
465 fskyi2(2,nn) = fy(3)
466 fskyi2(3,nn) = fz(3)
467 fskyi2(4,nn) = xmsi*h2(3)
468 fskyi2(5,nn) = abs(stifn(i)*h(3))
469C
470 nn = iadi2(4,i0)
471 fskyi2(1,nn) = fx(4)
472 fskyi2(2,nn) = fy(4)
473 fskyi2(3,nn) = fz(4)
474 fskyi2(4,nn) = xmsi*h2(4)
475 fskyi2(5,nn) = abs(stifn(i)*h(4))
476 ENDIF
477C
478C--- output of tied contact forces
479 CALL i2forces(x ,fs ,fx ,fy ,fz ,
480 . irect(1,l),nir ,fsav ,fncont ,fncontp,
481 . ftcontp ,weight ,h3d_data,i ,h)
482C
483 IF(iroddl==0)THEN
484 stifn(i)=em20
485 a(i1)=zero
486 a(i2)=zero
487 a(i3)=zero
488 END IF
489C
490C stokage ZERO pour noeuds delete par idel2
491 ELSEIF(weight(-i)==1) THEN
492 i0 = i0 + 1
493 nn = iadi2(1,i0)
494 fskyi2(1,nn) = zero
495 fskyi2(2,nn) = zero
496 fskyi2(3,nn) = zero
497 fskyi2(4,nn) = zero
498 fskyi2(5,nn) = zero
499 nn = iadi2(2,i0)
500 fskyi2(1,nn) = zero
501 fskyi2(2,nn) = zero
502 fskyi2(3,nn) = zero
503 fskyi2(4,nn) = zero
504 fskyi2(5,nn) = zero
505 nn = iadi2(3,i0)
506 fskyi2(1,nn) = zero
507 fskyi2(2,nn) = zero
508 fskyi2(3,nn) = zero
509 fskyi2(4,nn) = zero
510 fskyi2(5,nn) = zero
511 nn = iadi2(4,i0)
512 fskyi2(1,nn) = zero
513 fskyi2(2,nn) = zero
514 fskyi2(3,nn) = zero
515 fskyi2(4,nn) = zero
516 fskyi2(5,nn) = zero
517 ENDIF
518C----
519 ENDDO
520 ENDIF
521C
522 RETURN
523 END
524!||====================================================================
525!|| i2for3po ../engine/source/interfaces/interf/i2for3p.F
526!||--- called by ------------------------------------------------------
527!|| intti2f ../engine/source/interfaces/interf/intti2f.F
528!||--- calls -----------------------------------------------------
529!|| i2forces ../engine/source/interfaces/interf/i2forces.F
530!||--- uses -----------------------------------------------------
531!|| h3d_mod ../engine/share/modules/h3d_mod.F
532!||====================================================================
533 SUBROUTINE i2for3po(NSN ,NMN ,A ,CRST ,MSR ,
534 2 NSV ,MS ,WEIGHT ,STIFN ,MMASS ,
535 3 FSKYI2 ,IADI2 ,I0 ,NIR ,I2SIZE ,
536 4 IRECT ,X ,V ,FSAV ,FNCONT ,
537 5 IRTL ,H3D_DATA, CSTS_BIS,FNCONTP,FTCONTP)
538C-----------------------------------------------
539C M o d u l e s
540C-----------------------------------------------
541 USE h3d_mod
542C-----------------------------------------------
543C I m p l i c i t T y p e s
544C-----------------------------------------------
545#include "implicit_f.inc"
546C-----------------------------------------------
547C D u m m y A r g u m e n t s
548C-----------------------------------------------
549 INTEGER NSN, NMN, I0, NIR, I2SIZE,
550 . IRECT(4,*),IADI2(NIR,*),
551 . MSR(*), NSV(*), WEIGHT(*), IRTL(*)
552C REAL
553 my_real
554 . x(*),v(*),a(*), crst(2,*), ms(*), stifn(*), mmass(*),fsav(*),
555 . fskyi2(i2size,*),fncont(3,*),csts_bis(2,*),
556 . fncontp(3,*),ftcontp(3,*)
557 TYPE (H3D_DATABASE) :: H3D_DATA
558C-----------------------------------------------
559C L o c a l V a r i a b l e s
560C-----------------------------------------------
561 INTEGER I, J, I1, I2, I3, II, JJ, NN, L
562C REAL
563 my_real
564 . ss, st, xmsi, fs(3),sp,sm,tp,tm,
565 . h(4),h2(4),fx(4),fy(4),fz(4)
566C-----------------------------------------------
567C sauvegarde de la masse initiale
568 DO ii=1,nmn
569 j=msr(ii)
570 mmass(ii)=ms(j)
571 ENDDO
572C
573 IF (nir==2) THEN
574 DO ii=1,nsn
575 i=nsv(ii)
576 i3=3*i
577 i2=i3-1
578 i1=i2-1
579C traitement 1er noeud secnd
580 IF (weight(i)==1) THEN
581C
582 ss=crst(1,ii)
583 st=crst(2,ii)
584C
585 xmsi=ms(i)
586 fs(1)=a(i1)
587 fs(2)=a(i2)
588 fs(3)=a(i3)
589C
590 sp=one + ss
591 sm=one - ss
592 tp=fourth*(one + st)
593 tm=fourth*(one - st)
594 h(1)=tm*sm
595 h(2)=tm*sp
596C
597 fx(1:2) = fs(1)*h(1:2)
598 fy(1:2) = fs(2)*h(1:2)
599 fz(1:2) = fs(3)*h(1:2)
600 fx(3:4) = zero
601 fy(3:4) = zero
602 fz(3:4) = zero
603C
604 i0 = i0 + 1
605 nn = iadi2(1,i0)
606 fskyi2(1,nn) = fx(1)
607 fskyi2(2,nn) = fy(1)
608 fskyi2(3,nn) = fz(1)
609 fskyi2(4,nn) = xmsi*h(1)
610 fskyi2(5,nn) = abs(stifn(i)*h(1))
611C
612 nn = iadi2(2,i0)
613 fskyi2(1,nn) = fx(2)
614 fskyi2(2,nn) = fy(2)
615 fskyi2(3,nn) = fz(2)
616 fskyi2(4,nn) = xmsi*h(2)
617 fskyi2(5,nn) = abs(stifn(i)*h(2))
618 ENDIF
619 stifn(i)=em20
620 a(i1)=zero
621 a(i2)=zero
622 a(i3)=zero
623 ENDDO
624C NIR = 4
625 ELSE
626 DO ii=1,nsn
627 i=nsv(ii)
628 l = irtl(ii)
629 i3=3*i
630 i2=i3-1
631 i1=i2-1
632C traitement 1er noeud secnd
633 IF (weight(i)==1) THEN
634C
635 xmsi=ms(i)
636 fs(1)=a(i1)
637 fs(2)=a(i2)
638 fs(3)=a(i3)
639C
640 ss=crst(1,ii)
641 st=crst(2,ii)
642 sp=one + ss
643 sm=one - ss
644 tp=fourth*(one + st)
645 tm=fourth*(one - st)
646 h(1)=tm*sm
647 h(2)=tm*sp
648 h(3)=tp*sp
649 h(4)=tp*sm
650
651C Additional shape functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
652 ss=csts_bis(1,ii)
653 st=csts_bis(2,ii)
654 sp=one + ss
655 sm=one - ss
656 tp=fourth*(one + st)
657 tm=fourth*(one - st)
658 h2(1)=tm*sm
659 h2(2)=tm*sp
660 h2(3)=tp*sp
661 h2(4)=tp*sm
662C
663 fx(1:4) = fs(1)*h(1:4)
664 fy(1:4) = fs(2)*h(1:4)
665 fz(1:4) = fs(3)*h(1:4)
666C
667 i0 = i0 + 1
668 nn = iadi2(1,i0)
669 fskyi2(1,nn) = fx(1)
670 fskyi2(2,nn) = fy(1)
671 fskyi2(3,nn) = fz(1)
672 fskyi2(4,nn) = xmsi*h2(1)
673 fskyi2(5,nn) = abs(stifn(i)*h(1))
674C
675 nn = iadi2(2,i0)
676 fskyi2(1,nn) = fx(2)
677 fskyi2(2,nn) = fy(2)
678 fskyi2(3,nn) = fz(2)
679 fskyi2(4,nn) = xmsi*h2(2)
680 fskyi2(5,nn) = abs(stifn(i)*h(2))
681C
682 nn = iadi2(3,i0)
683 fskyi2(1,nn) = fx(3)
684 fskyi2(2,nn) = fy(3)
685 fskyi2(3,nn) = fz(3)
686 fskyi2(4,nn) = xmsi*h2(3)
687 fskyi2(5,nn) = abs(stifn(i)*h(3))
688C
689 nn = iadi2(4,i0)
690 fskyi2(1,nn) = fx(4)
691 fskyi2(2,nn) = fy(4)
692 fskyi2(3,nn) = fz(4)
693 fskyi2(4,nn) = xmsi*h2(4)
694 fskyi2(5,nn) = abs(stifn(i)*h(4))
695 ENDIF
696C
697C--- output of tied contact forces
698 CALL i2forces(x ,fs ,fx ,fy ,fz ,
699 . irect(1,l),nir ,fsav ,fncont ,fncontp,
700 . ftcontp ,weight ,h3d_data,i ,h)
701C
702 stifn(i)=em20
703 a(i1)=zero
704 a(i2)=zero
705 a(i3)=zero
706C----
707 ENDDO
708 ENDIF
709C
710 RETURN
711 END
712
713!||====================================================================
714!|| i2mom3pn ../engine/source/interfaces/interf/i2for3p.F
715!||--- called by ------------------------------------------------------
716!|| intti2f ../engine/source/interfaces/interf/intti2f.F
717!||--- uses -----------------------------------------------------
718!|| h3d_mod ../engine/share/modules/h3d_mod.F
719!||====================================================================
720 SUBROUTINE i2mom3pn(NSN ,NMN ,AR ,IRECT,CRST ,
721 2 MSR ,NSV ,IRTL ,IN ,MS ,
722 3 A ,X ,WEIGHT,STIFR,FSKYI2,
723 4 STIFN,IADI2,I0 ,NIR ,I2SIZE,
724 5 IDEL2,SMASS,SINER ,MINER,ADI ,
725 6 H3D_DATA,CSTS_BIS)
726C-----------------------------------------------
727C M o d u l e s
728C-----------------------------------------------
729 USE h3d_mod
730C-----------------------------------------------
731C I m p l i c i t T y p e s
732C-----------------------------------------------
733#include "implicit_f.inc"
734C-----------------------------------------------
735C D u m m y A r g u m e n t s
736C-----------------------------------------------
737 INTEGER NSN, NMN, I0 ,NIR ,I2SIZE, IDEL2,
738 . irect(4,*), msr(*), nsv(*), irtl(*), weight(*),
739 . iadi2(nir,*)
740C REAL
741 my_real
742 . a(3,*), ar(3,*),crst(2,*), ms(*),
743 . x(3,*),in(*),stifr(*), fskyi2(i2size,*), stifn(*),
744 . smass(*), siner(*), miner(*), adi(*), csts_bis(2,*)
745 TYPE (H3D_DATABASE) :: H3D_DATA
746C-----------------------------------------------
747C C o m m o n B l o c k s
748C-----------------------------------------------
749#include "scr14_c.inc"
750#include "scr16_c.inc"
751C-----------------------------------------------
752C L o c a l V a r i a b l e s
753C-----------------------------------------------
754 INTEGER I, J, II, L, NN
755C REAL
756 my_real
757 . ss, st, xmsi, fs(3), moms(3),ins,
758 . x0,x1,x2,x3,x4,y0,y1,y2,y3,y4,z0,z1,z2,z3,z4,aa,
759 . xc0,yc0,zc0,sp,sm,tp,tm,xc,yc,zc,
760 . stf,ai,inmx,h(4),h2(4)
761C-----------------------------------------------
762C MINER(II) initialise a MS(J) dans resol_init
763 IF(anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
764 DO ii=1,nmn
765 j=msr(ii)
766 adi(j) = adi(j)*miner(ii)
767 ENDDO
768 ENDIF
769
770 DO ii=1,nmn
771 j=msr(ii)
772 in(j)=max(em20,in(j))
773 ENDDO
774C
775 IF (nir == 2) THEN
776 DO ii=1,nsn
777 i=nsv(ii)
778 IF(i>0)THEN
779 IF (weight(i)==1) THEN
780 l=irtl(ii)
781C
782 ss=crst(1,ii)
783 st=crst(2,ii)
784 sp=one + ss
785 sm=one - ss
786 tp=fourth*(one + st)
787 tm=fourth*(one - st)
788 h(1)=tm*sm
789 h(2)=tm*sp
790
791C Additional shape functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
792 ss=csts_bis(1,ii)
793 st=csts_bis(2,ii)
794 sp=one + ss
795 sm=one - ss
796 tp=fourth*(one + st)
797 tm=fourth*(one - st)
798 h2(1)=tm*sm
799 h2(2)=tm*sp
800C
801 x0 = x(1,i)
802 y0 = x(2,i)
803 z0 = x(3,i)
804C
805 x1 = x(1,irect(1,l))
806 y1 = x(2,irect(1,l))
807 z1 = x(3,irect(1,l))
808 x2 = x(1,irect(2,l))
809 y2 = x(2,irect(2,l))
810 z2 = x(3,irect(2,l))
811C
812 xc = x1 * h(1) + x2 * h(2)
813 yc = y1 * h(1) + y2 * h(2)
814 zc = z1 * h(1) + z2 * h(2)
815C
816 xc0=x0-xc
817 yc0=y0-yc
818 zc0=z0-zc
819C
820 aa = xc0*xc0 + yc0*yc0 + zc0*zc0
821 ins = in(i) + aa * ms(i)
822 stf = stifr(i) + aa * stifn(i)
823C
824 IF (anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
825 ai=aa * ms(i)
826 adi(irect(1,l))=adi(irect(1,l))+ai*h(1)
827 adi(irect(2,l))=adi(irect(2,l))+ai*h(2)
828 END IF
829C
830 fs(1)=a(1,i)
831 fs(2)=a(2,i)
832 fs(3)=a(3,i)
833C
834 moms(1) = ar(1,i) + yc0 * fs(3) - zc0 * fs(2)
835 moms(2) = ar(2,i) + zc0 * fs(1) - xc0 * fs(3)
836 moms(3) = ar(3,i) + xc0 * fs(2) - yc0 * fs(1)
837C
838 i0 = i0 + 1
839 DO j = 1,nir
840 IF (in(irect(j,l)) > em20) THEN
841 nn = iadi2(j,i0)
842 fskyi2(6,nn) = moms(1)*h(j)
843 fskyi2(7,nn) = moms(2)*h(j)
844 fskyi2(8,nn) = moms(3)*h(j)
845 fskyi2(9,nn) = ins*h2(j)
846 fskyi2(10,nn)= abs(stf*h(j))
847C
848 ELSE
849 nn = iadi2(j,i0)
850 fskyi2(6,nn) = zero
851 fskyi2(7,nn) = zero
852 fskyi2(8,nn) = zero
853 fskyi2(9,nn) = zero
854 fskyi2(10,nn)= zero
855C
856 END IF
857 ENDDO
858 ENDIF
859 stifr(i)=em20
860 IF(idel2/=0.AND.in(i)/=0.)siner(ii)=in(i)
861 in(i)=zero
862 stifn(i)=em20
863 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
864 ms(i)=zero
865 a(1,i)=zero
866 a(2,i)=zero
867 a(3,i)=zero
868C stokage ZERO pour noeuds delete par idel2
869 ELSEIF(weight(-i)==1) THEN
870 i0 = i0 + 1
871 nn = iadi2(1,i0)
872 fskyi2(6,nn) = zero
873 fskyi2(7,nn) = zero
874 fskyi2(8,nn) = zero
875 fskyi2(9,nn) = zero
876 fskyi2(10,nn) = zero
877 nn = iadi2(2,i0)
878 fskyi2(6,nn) = zero
879 fskyi2(7,nn) = zero
880 fskyi2(8,nn) = zero
881 fskyi2(9,nn) = zero
882 fskyi2(10,nn) = zero
883 ENDIF
884 ENDDO
885 ELSE
886
887 DO ii=1,nsn
888 i=nsv(ii)
889 IF(i>0)THEN
890 IF (weight(i)==1) THEN
891 l=irtl(ii)
892C
893 ss=crst(1,ii)
894 st=crst(2,ii)
895 sp=one + ss
896 sm=one - ss
897 tp=fourth*(one + st)
898 tm=fourth*(one - st)
899 h(1)=tm*sm
900 h(2)=tm*sp
901 h(3)=tp*sp
902 h(4)=tp*sm
903
904C Additional shape functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
905 ss=csts_bis(1,ii)
906 st=csts_bis(2,ii)
907 sp=one + ss
908 sm=one - ss
909 tp=fourth*(one + st)
910 tm=fourth*(one - st)
911 h2(1)=tm*sm
912 h2(2)=tm*sp
913 h2(3)=tp*sp
914 h2(4)=tp*sm
915C
916 x0 = x(1,i)
917 y0 = x(2,i)
918 z0 = x(3,i)
919C
920 x1 = x(1,irect(1,l))
921 y1 = x(2,irect(1,l))
922 z1 = x(3,irect(1,l))
923 x2 = x(1,irect(2,l))
924 y2 = x(2,irect(2,l))
925 z2 = x(3,irect(2,l))
926 x3 = x(1,irect(3,l))
927 y3 = x(2,irect(3,l))
928 z3 = x(3,irect(3,l))
929 x4 = x(1,irect(4,l))
930 y4 = x(2,irect(4,l))
931 z4 = x(3,irect(4,l))
932C
933 xc = x1 * h(1) + x2 * h(2) + x3 * h(3) + x4 * h(4)
934 yc = y1 * h(1) + y2 * h(2) + y3 * h(3) + y4 * h(4)
935 zc = z1 * h(1) + z2 * h(2) + z3 * h(3) + z4 * h(4)
936C
937 xc0=x0-xc
938 yc0=y0-yc
939 zc0=z0-zc
940C
941 aa = xc0*xc0 + yc0*yc0 + zc0*zc0
942 ins = in(i) + aa * ms(i)
943 stf = stifr(i) + aa * stifn(i)
944C
945 IF (anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
946 ai=aa * ms(i)
947 adi(irect(1,l))=adi(irect(1,l))+ai*h(1)
948 adi(irect(2,l))=adi(irect(2,l))+ai*h(2)
949 adi(irect(3,l))=adi(irect(3,l))+ai*h(3)
950 adi(irect(4,l))=adi(irect(4,l))+ai*h(4)
951 END IF
952C
953 fs(1)=a(1,i)
954 fs(2)=a(2,i)
955 fs(3)=a(3,i)
956C
957 moms(1) = ar(1,i) + yc0 * fs(3) - zc0 * fs(2)
958 moms(2) = ar(2,i) + zc0 * fs(1) - xc0 * fs(3)
959 moms(3) = ar(3,i) + xc0 * fs(2) - yc0 * fs(1)
960C
961 i0 = i0 + 1
962 DO j = 1,nir
963 IF (in(irect(j,l)) > em20) THEN
964 nn = iadi2(j,i0)
965 fskyi2(6,nn) = moms(1)*h(j)
966 fskyi2(7,nn) = moms(2)*h(j)
967 fskyi2(8,nn) = moms(3)*h(j)
968 fskyi2(9,nn) = ins*h2(j)
969 fskyi2(10,nn)= abs(stf*h(j))
970C
971 ELSE
972 nn = iadi2(j,i0)
973 fskyi2(6,nn) = zero
974 fskyi2(7,nn) = zero
975 fskyi2(8,nn) = zero
976 fskyi2(9,nn) = zero
977 fskyi2(10,nn)= zero
978C
979 END IF
980 ENDDO
981 ENDIF
982 stifr(i)=em20
983 IF(idel2/=0.AND.in(i)/=0.)siner(ii)=in(i)
984 in(i)=zero
985 stifn(i)=em20
986 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
987 ms(i)=zero
988 a(1,i)=zero
989 a(2,i)=zero
990 a(3,i)=zero
991C stokage ZERO pour noeuds delete par idel2
992 ELSEIF(weight(-i)==1) THEN
993 i0 = i0 + 1
994 nn = iadi2(1,i0)
995 fskyi2(6,nn) = zero
996 fskyi2(7,nn) = zero
997 fskyi2(8,nn) = zero
998 fskyi2(9,nn) = zero
999 fskyi2(10,nn) = zero
1000 nn = iadi2(2,i0)
1001 fskyi2(6,nn) = zero
1002 fskyi2(7,nn) = zero
1003 fskyi2(8,nn) = zero
1004 fskyi2(9,nn) = zero
1005 fskyi2(10,nn) = zero
1006 nn = iadi2(3,i0)
1007 fskyi2(6,nn) = zero
1008 fskyi2(7,nn) = zero
1009 fskyi2(8,nn) = zero
1010 fskyi2(9,nn) = zero
1011 fskyi2(10,nn) = zero
1012 nn = iadi2(4,i0)
1013 fskyi2(6,nn) = zero
1014 fskyi2(7,nn) = zero
1015 fskyi2(8,nn) = zero
1016 fskyi2(9,nn) = zero
1017 fskyi2(10,nn) = zero
1018 ENDIF
1019 ENDDO
1020C
1021 ENDIF
1022C
1023C Traitement specifique pour ADI
1024C
1025 IF(anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
1026#include "vectorize.inc"
1027 DO ii=1,nmn
1028 j=msr(ii)
1029 adi(j) = adi(j)/max(em20,miner(ii))
1030 ENDDO
1031 ENDIF
1032C
1033 RETURN
1034 END
1035C dev023 routine duale de i2mom3 pour parith/on spmd
1036!||====================================================================
1037!|| i2mom3p ../engine/source/interfaces/interf/i2for3p.F
1038!||--- called by ------------------------------------------------------
1039!|| intti2f ../engine/source/interfaces/interf/intti2f.F
1040!||====================================================================
1041 SUBROUTINE i2mom3p(NSN ,NMN,AR ,IRECT ,CRST ,
1042 2 MSR ,NSV,IRTL ,IN ,MS ,
1043 3 A ,X ,WEIGHT,STIFR ,FSKYI2,
1044 4 IADI2,I0 ,NIR ,I2SIZE,STIFN ,
1045 4 CSTS_BIS)
1046C-----------------------------------------------
1047C I m p l i c i t T y p e s
1048C-----------------------------------------------
1049#include "implicit_f.inc"
1050C-----------------------------------------------
1051C D u m m y A r g u m e n t s
1052C-----------------------------------------------
1053 INTEGER NSN, NMN, I0 ,NIR ,I2SIZE,
1054 . IRECT(4,*), MSR(*), NSV(*), IRTL(*), WEIGHT(*),
1055 . iadi2(nir,*)
1056C REAL
1057 my_real
1058 . a(3,*), ar(3,*),crst(2,*), ms(*),
1059 . x(3,*),in(*),stifr(*), fskyi2(i2size,*), stifn(*), csts_bis(2,*)
1060C-----------------------------------------------
1061C L o c a l V a r i a b l e s
1062C-----------------------------------------------
1063 INTEGER I, J, II, L, NN
1064C REAL
1065 my_real
1066 . SS, ST, XMSI, FS(3), MOMS(3),INS,
1067 . X0,X1,X2,X3,X4,Y0,Y1,Y2,Y3,Y4,Z0,Z1,Z2,Z3,Z4,AA,INMX,
1068 . XC0,YC0,ZC0,SP,SM,TP,TM,XC,YC,ZC,H1, H2,H3,H4,STF,
1069 . H21,H22,H23,H24
1070C-----------------------------------------------
1071#include "vectorize.inc"
1072 DO II=1,nmn
1073 j=msr(ii)
1074 in(j)=max(em20,in(j))
1075 ENDDO
1076C
1077 DO ii=1,nsn
1078 i=nsv(ii)
1079 IF (weight(i)==1) THEN
1080 l=irtl(ii)
1081C
1082 ss=crst(1,ii)
1083 st=crst(2,ii)
1084 sp=one + ss
1085 sm=one - ss
1086 tp=fourth*(one + st)
1087 tm=fourth*(one - st)
1088 h1=tm*sm
1089 h2=tm*sp
1090 h3=tp*sp
1091 h4=tp*sm
1092
1093C Additional shape functions for distribution of mass / inertia - to avoid negative masses for projection outside of the element
1094 ss=csts_bis(1,ii)
1095 st=csts_bis(2,ii)
1096 sp=one + ss
1097 sm=one - ss
1098 tp=fourth*(one + st)
1099 tm=fourth*(one - st)
1100 h21=tm*sm
1101 h22=tm*sp
1102 h23=tp*sp
1103 h24=tp*sm
1104C
1105 x0 = x(1,i)
1106 y0 = x(2,i)
1107 z0 = x(3,i)
1108C
1109 x1 = x(1,irect(1,l))
1110 y1 = x(2,irect(1,l))
1111 z1 = x(3,irect(1,l))
1112 x2 = x(1,irect(2,l))
1113 y2 = x(2,irect(2,l))
1114 z2 = x(3,irect(2,l))
1115 x3 = x(1,irect(3,l))
1116 y3 = x(2,irect(3,l))
1117 z3 = x(3,irect(3,l))
1118 x4 = x(1,irect(4,l))
1119 y4 = x(2,irect(4,l))
1120 z4 = x(3,irect(4,l))
1121C
1122 xc = x1 * h1 + x2 * h2 + x3 * h3 + x4 * h4
1123 yc = y1 * h1 + y2 * h2 + y3 * h3 + y4 * h4
1124 zc = z1 * h1 + z2 * h2 + z3 * h3 + z4 * h4
1125C
1126 xc0=x0-xc
1127 yc0=y0-yc
1128 zc0=z0-zc
1129C
1130 aa = xc0*xc0 + yc0*yc0 + zc0*zc0
1131 ins = in(i) + aa * ms(i)
1132 stf = stifr(i) + aa * stifn(i)
1133C
1134 fs(1)=a(1,i)
1135 fs(2)=a(2,i)
1136 fs(3)=a(3,i)
1137C
1138 moms(1) = ar(1,i) + yc0 * fs(3) - zc0 * fs(2)
1139 moms(2) = ar(2,i) + zc0 * fs(1) - xc0 * fs(3)
1140 moms(3) = ar(3,i) + xc0 * fs(2) - yc0 * fs(1)
1141C
1142 i0 = i0 + 1
1143 inmx = zero
1144 DO j = 1,nir
1145 inmx = max(inmx,in(irect(j,l)))
1146 ENDDO
1147 IF (inmx > em20) THEN
1148 nn = iadi2(1,i0)
1149 fskyi2(6,nn) = moms(1)*h1
1150 fskyi2(7,nn) = moms(2)*h1
1151 fskyi2(8,nn) = moms(3)*h1
1152 fskyi2(9,nn) = ins*h21
1153 fskyi2(10,nn)= stf*h1
1154C
1155 nn = iadi2(2,i0)
1156 fskyi2(6,nn) = moms(1)*h2
1157 fskyi2(7,nn) = moms(2)*h2
1158 fskyi2(8,nn) = moms(3)*h2
1159 fskyi2(9,nn) = ins*h22
1160 fskyi2(10,nn)= stf*h2
1161C
1162 nn = iadi2(3,i0)
1163 fskyi2(6,nn) = moms(1)*h3
1164 fskyi2(7,nn) = moms(2)*h3
1165 fskyi2(8,nn) = moms(3)*h3
1166 fskyi2(9,nn) = ins*h23
1167 fskyi2(10,nn)= stf*h3
1168C
1169 nn = iadi2(4,i0)
1170 fskyi2(6,nn) = moms(1)*h4
1171 fskyi2(7,nn) = moms(2)*h4
1172 fskyi2(8,nn) = moms(3)*h4
1173 fskyi2(9,nn) = ins*h24
1174 fskyi2(10,nn)= stf*h4
1175 ELSE
1176 nn = iadi2(1,i0)
1177 fskyi2(6,nn) = zero
1178 fskyi2(7,nn) = zero
1179 fskyi2(8,nn) = zero
1180 fskyi2(9,nn) = zero
1181 fskyi2(10,nn)= zero
1182C
1183 nn = iadi2(2,i0)
1184 fskyi2(6,nn) = zero
1185 fskyi2(7,nn) = zero
1186 fskyi2(8,nn) = zero
1187 fskyi2(9,nn) = zero
1188 fskyi2(10,nn)= zero
1189C
1190 nn = iadi2(3,i0)
1191 fskyi2(6,nn) = zero
1192 fskyi2(7,nn) = zero
1193 fskyi2(8,nn) = zero
1194 fskyi2(9,nn) = zero
1195 fskyi2(10,nn)= zero
1196C
1197 nn = iadi2(4,i0)
1198 fskyi2(6,nn) = zero
1199 fskyi2(7,nn) = zero
1200 fskyi2(8,nn) = zero
1201 fskyi2(9,nn) = zero
1202 fskyi2(10,nn)= zero
1203 END IF
1204 ENDIF
1205 stifr(i)=em20
1206 in(i)=zero
1207 stifn(i)=em20
1208 a(1,i)=zero
1209 a(2,i)=zero
1210 a(3,i)=zero
1211C
1212 ENDDO
1213C
1214C
1215 RETURN
1216 END
1217C dev023 routine duale de i2fomo3 pour parith/on spmd
1218C==========================================================================
1219!||====================================================================
1220!|| i2fomo3p ../engine/source/interfaces/interf/i2for3p.F
1221!||--- called by ------------------------------------------------------
1222!|| intti2f ../engine/source/interfaces/interf/intti2f.F
1223!||--- calls -----------------------------------------------------
1224!|| i2forces ../engine/source/interfaces/interf/i2forces.F
1225!||--- uses -----------------------------------------------------
1226!|| h3d_mod ../engine/share/modules/h3d_mod.F
1227!||====================================================================
1228 SUBROUTINE i2fomo3p(
1229 1 NSN ,NMN ,A ,IRECT ,DPARA ,
1230 2 MSR ,NSV ,IRTL ,MS ,WEIGHT ,
1231 3 AR ,IN ,X ,STIFN ,STIFR ,
1232 4 FSKYI2 ,IADI2 ,ILEV ,DMAST ,ADM ,
1233 5 MMASS ,I0 ,NIR ,I2SIZE ,IDEL2 ,
1234 6 SMASS ,SINER ,V ,CRST ,FSAV ,
1235 7 FNCONT ,H3D_DATA,FNCONTP,FTCONTP )
1236C-----------------------------------------------
1237C M o d u l e s
1238C-----------------------------------------------
1239 USE h3d_mod
1240C-----------------------------------------------
1241C I m p l i c i t T y p e s
1242C-----------------------------------------------
1243#include "implicit_f.inc"
1244C-----------------------------------------------
1245C D u m m y A r g u m e n t s
1246C-----------------------------------------------
1247 INTEGER NSN, NMN, ILEV, I0, NIR, I2SIZE, IDEL2,
1248 . IRECT(4,*), MSR(*), NSV(*), IRTL(*), WEIGHT(*),
1249 . IADI2(NIR,*)
1250C REAL
1251 my_real
1252 . A(3,*),AR(3,*), X(3,*),V(*), FSKYI2(I2SIZE,*),MMASS(*),
1253 . DPARA(7,*), MS(*), IN(*),STIFN(*),STIFR(*),DMAST,ADM(*),
1254 . SMASS(*), SINER(*),FSAV(*), CRST(2,*),FNCONT(3,*),
1255 . FNCONTP(3,*),FTCONTP(3,*)
1256 TYPE (H3D_DATABASE) :: H3D_DATA
1257C-----------------------------------------------
1258C C o m m o n B l o c k s
1259C-----------------------------------------------
1260#include "scr14_c.inc"
1261#include "scr16_c.inc"
1262C-----------------------------------------------
1263C L o c a l V a r i a b l e s
1264C-----------------------------------------------
1265 INTEGER I, J, J1,J2,J3,J4, II, L, JJ, NN,NISKY2
1266C REAL
1267 my_real
1268 . h(4),
1269 . s,t,ss, st, xmsi, fs(3),sp,sm,tp,tm,
1270 . moms(3),det,fx0,fy0,fz0,ins,
1271 . x0,x1,x2,x3,x4,xs,y0,y1,y2,y3,y4,ys,z0,z1,z2,z3,z4,zs,
1272 . x12,x22,x32,x42,y12,y22,y32,y42,z12,z22,z32,z42,
1273 . xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,
1274 . a1,a2,a3,b1,b2,b3,c1,c2,c3,mr,mrx,mry,mrz,inx,iny,inz,stf,
1275 . fx(4),fy(4),fz(4)
1276C=======================================================================
1277C Traitement specifique pour DMAS
1278C
1279C MMASS(II) initialise a MS(J) a t=0 dans starter
1280 IF(anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS >0.AND.ilev==1) THEN
1281 DO ii=1,nmn
1282 j=msr(ii)
1283 adm(j) = adm(j)*mmass(ii)
1284 ENDDO
1285 ENDIF
1286C------------------------------
1287C FORCES ET MOMENTS DES NOEUDS SECONDS
1288C TRANSMIS AUX NOEUDS MAINS SOUS
1289C FORME DE FORCES
1290C
1291C MASSES ET INERTIES DES NOEUDS SECONDS
1292C TRANSMISES AUX NOEUDS MAINS SOUS
1293C FORME DE MASSES
1294C------------------------------
1295C
1296 DO ii=1,nsn
1297 i=nsv(ii)
1298 IF(i>0)THEN
1299 l=irtl(ii)
1300C
1301 s = crst(1,ii)
1302 t = crst(2,ii)
1303 sp=one + s
1304 sm=one - s
1305 tp=fourth*(one + t)
1306 tm=fourth*(one - t)
1307C
1308 h(1)=one/nir
1309 h(2)=one/nir
1310 h(3)=one/nir
1311 h(4)=one/nir
1312C
1313 j1=irect(1,l)
1314 j2=irect(2,l)
1315 j3=irect(3,l)
1316 j4=irect(4,l)
1317 x1=x(1,j1)
1318 y1=x(2,j1)
1319 z1=x(3,j1)
1320 x2=x(1,j2)
1321 y2=x(2,j2)
1322 z2=x(3,j2)
1323 x3=x(1,j3)
1324 y3=x(2,j3)
1325 z3=x(3,j3)
1326 x4=x(1,j4)
1327 y4=x(2,j4)
1328 z4=x(3,j4)
1329 x0=fourth*(x1+x2+x3+x4)
1330 y0=fourth*(y1+y2+y3+y4)
1331 z0=fourth*(z1+z2+z3+z4)
1332 x1=x1-x0
1333 y1=y1-y0
1334 z1=z1-z0
1335 x2=x2-x0
1336 y2=y2-y0
1337 z2=z2-z0
1338 x3=x3-x0
1339 y3=y3-y0
1340 z3=z3-z0
1341 x4=x4-x0
1342 y4=y4-y0
1343 z4=z4-z0
1344 xs=x(1,i)-x0
1345 ys=x(2,i)-y0
1346 zs=x(3,i)-z0
1347C
1348 x12=x1*x1
1349 x22=x2*x2
1350 x32=x3*x3
1351 x42=x4*x4
1352 y12=y1*y1
1353 y22=y2*y2
1354 y32=y3*y3
1355 y42=y4*y4
1356 z12=z1*z1
1357 z22=z2*z2
1358 z32=z3*z3
1359 z42=z4*z4
1360 xx=x12 + x22 + x32 + x42
1361 yy=y12 + y22 + y32 + y42
1362 zz=z12 + z22 + z32 + z42
1363 xy=x1*y1 + x2*y2 + x3*y3 + x4*y4
1364 yz=y1*z1 + y2*z2 + y3*z3 + y4*z4
1365 zx=z1*x1 + z2*x2 + z3*x3 + z4*x4
1366 zzz=xx+yy
1367 xxx=yy+zz
1368 yyy=zz+xx
1369 xy2=xy*xy
1370 yz2=yz*yz
1371 zx2=zx*zx
1372 det= xxx*yyy*zzz - xxx*yz2 - yyy*zx2 - zzz*xy2
1373 . - two*xy*yz*zx
1374 det=one/det
1375 b1=zzz*yyy-yz2
1376 b2=xxx*zzz-zx2
1377 b3=yyy*xxx-xy2
1378 c3=zzz*xy+yz*zx
1379 c1=xxx*yz+zx*xy
1380 c2=yyy*zx+xy*yz
1381C
1382 dpara(1,ii)=det
1383 dpara(2,ii)=b1
1384 dpara(3,ii)=b2
1385 dpara(4,ii)=b3
1386 dpara(5,ii)=c1
1387 dpara(6,ii)=c2
1388 dpara(7,ii)=c3
1389C
1390 IF (weight(i)==1) THEN
1391 xmsi=ms(i)
1392 fs(1)=a(1,i)
1393 fs(2)=a(2,i)
1394 fs(3)=a(3,i)
1395 ins=in(i)
1396 moms(1)=ar(1,i) + ys*fs(3) - zs*fs(2)
1397 moms(2)=ar(2,i) + zs*fs(1) - xs*fs(3)
1398 moms(3)=ar(3,i) + xs*fs(2) - ys*fs(1)
1399C
1400 a1=det*(moms(1)*b1+moms(2)*c3+moms(3)*c2)
1401 a2=det*(moms(2)*b2+moms(3)*c1+moms(1)*c3)
1402 a3=det*(moms(3)*b3+moms(1)*c2+moms(2)*c1)
1403C
1404 fx0=fs(1)*fourth
1405 fy0=fs(2)*fourth
1406 fz0=fs(3)*fourth
1407C
1408C------------------------------------------------------
1409C INERTIES => MASSES
1410C------------------------------------------------------
1411C
1412 inx=ins + xmsi*(xs*xs+ys*ys+zs*zs)
1413 mrx = (b1+c3+c2)
1414 mry = (b2+c1+c3)
1415 mrz = (b3+c2+c1)
1416 mr=det*inx*max(mrx,mry,mrz)
1417C
1418C------------------------------------------------------
1419C MASSES & FORCES TRANSMISES AUX NOEUDS MAINS
1420C------------------------------------------------------
1421 IF(ilev==1)THEN
1422 xmsi=fourth*xmsi+mr
1423 ELSEIF(ilev==3)THEN
1424 xmsi=max(fourth*xmsi,mr)
1425 ENDIF
1426C
1427 stf = fourth*stifn(i)
1428 . + det*max(mrx,mry,mrz)*(stifr(i)+stifn(i)*(xs*xs+ys*ys+zs*zs))
1429 i0 = i0 + 1
1430 nn = iadi2(1,i0)
1431 fx(1) = fx0 + a2*z1 - a3*y1
1432 fy(1) = fy0 + a3*x1 - a1*z1
1433 fz(1) = fz0 + a1*y1 - a2*x1
1434 fskyi2(1,nn) = fx(1)
1435 fskyi2(2,nn) = fy(1)
1436 fskyi2(3,nn) = fz(1)
1437 fskyi2(4,nn) = xmsi
1438 fskyi2(5,nn) = stf
1439 fskyi2(6,nn) = zero
1440 fskyi2(7,nn) = zero
1441 fskyi2(8,nn) = zero
1442 fskyi2(9,nn) = zero
1443 fskyi2(10,nn)= zero
1444 nn = iadi2(2,i0)
1445 fx(2) = fx0 + a2*z2 - a3*y2
1446 fy(2) = fy0 + a3*x2 - a1*z2
1447 fz(2) = fz0 + a1*y2 - a2*x2
1448 fskyi2(1,nn) = fx(2)
1449 fskyi2(2,nn) = fy(2)
1450 fskyi2(3,nn) = fz(2)
1451 fskyi2(4,nn) = xmsi
1452 fskyi2(5,nn) = stf
1453 fskyi2(6,nn) = zero
1454 fskyi2(7,nn) = zero
1455 fskyi2(8,nn) = zero
1456 fskyi2(9,nn) = zero
1457 fskyi2(10,nn)= zero
1458 nn = iadi2(3,i0)
1459 fx(3) = fx0 + a2*z3 - a3*y3
1460 fy(3) = fy0 + a3*x3 - a1*z3
1461 fz(3) = fz0 + a1*y3 - a2*x3
1462 fskyi2(1,nn) = fx(3)
1463 fskyi2(2,nn) = fy(3)
1464 fskyi2(3,nn) = fz(3)
1465 fskyi2(4,nn) = xmsi
1466 fskyi2(5,nn) = stf
1467 fskyi2(6,nn) = zero
1468 fskyi2(7,nn) = zero
1469 fskyi2(8,nn) = zero
1470 fskyi2(9,nn) = zero
1471 fskyi2(10,nn)= zero
1472 nn = iadi2(4,i0)
1473 fx(4) = fx0 + a2*z4 - a3*y4
1474 fy(4) = fy0 + a3*x4 - a1*z4
1475 fz(4) = fz0 + a1*y4 - a2*x4
1476 fskyi2(1,nn) = fx(4)
1477 fskyi2(2,nn) = fy(4)
1478 fskyi2(3,nn) = fz(4)
1479 fskyi2(4,nn) = xmsi
1480 fskyi2(5,nn) = stf
1481 fskyi2(6,nn) = zero
1482 fskyi2(7,nn) = zero
1483 fskyi2(8,nn) = zero
1484 fskyi2(9,nn) = zero
1485 fskyi2(10,nn)= zero
1486C
1487 dmast = dmast + 4.*xmsi - ms(i)
1488 IF (anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS >0) THEN
1489 adm(j1) = adm(j1) + xmsi - fourth*ms(i)
1490 adm(j2) = adm(j2) + xmsi - fourth*ms(i)
1491 adm(j3) = adm(j3) + xmsi - fourth*ms(i)
1492 adm(j4) = adm(j4) + xmsi - fourth*ms(i)
1493 ENDIF
1494 ENDIF
1495 stifn(i)=em20
1496 IF(idel2/=0.AND.ms(i)/=0.)smass(ii)=ms(i)
1497 ms(i)=zero
1498 stifr(i)=em20
1499 IF(idel2/=0.AND.in(i)/=0.)siner(ii)=in(i)
1500 in(i)=zero
1501C
1502C--- output of tied contact forces
1503 CALL i2forces(x ,fs ,fx ,fy ,fz ,
1504 . irect(1,l),nir ,fsav ,fncont ,fncontp,
1505 . ftcontp ,weight ,h3d_data,i ,h)
1506C----
1507C stokage ZERO pour noeuds delete par idel2
1508 ELSEIF(weight(-i)==1) THEN
1509 i0 = i0 + 1
1510 nn = iadi2(1,i0)
1511 fskyi2(1,nn) = zero
1512 fskyi2(2,nn) = zero
1513 fskyi2(3,nn) = zero
1514 fskyi2(4,nn) = zero
1515 fskyi2(5,nn) = zero
1516 fskyi2(6,nn) = zero
1517 fskyi2(7,nn) = zero
1518 fskyi2(8,nn) = zero
1519 fskyi2(9,nn) = zero
1520 fskyi2(10,nn)= zero
1521 nn = iadi2(2,i0)
1522 fskyi2(1,nn) = zero
1523 fskyi2(2,nn) = zero
1524 fskyi2(3,nn) = zero
1525 fskyi2(4,nn) = zero
1526 fskyi2(5,nn) = zero
1527 fskyi2(6,nn) = zero
1528 fskyi2(7,nn) = zero
1529 fskyi2(8,nn) = zero
1530 fskyi2(9,nn) = zero
1531 fskyi2(10,nn)= zero
1532 nn = iadi2(3,i0)
1533 fskyi2(1,nn) = zero
1534 fskyi2(2,nn) = zero
1535 fskyi2(3,nn) = zero
1536 fskyi2(4,nn) = zero
1537 fskyi2(5,nn) = zero
1538 fskyi2(6,nn) = zero
1539 fskyi2(7,nn) = zero
1540 fskyi2(8,nn) = zero
1541 fskyi2(9,nn) = zero
1542 fskyi2(10,nn)= zero
1543 nn = iadi2(4,i0)
1544 fskyi2(1,nn) = zero
1545 fskyi2(2,nn) = zero
1546 fskyi2(3,nn) = zero
1547 fskyi2(4,nn) = zero
1548 fskyi2(5,nn) = zero
1549 fskyi2(6,nn) = zero
1550 fskyi2(7,nn) = zero
1551 fskyi2(8,nn) = zero
1552 fskyi2(9,nn) = zero
1553 fskyi2(10,nn)= zero
1554 ENDIF
1555 ENDDO
1556C
1557C
1558C Traitement specifique pour ADM
1559C
1560 IF(anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS >0.AND.ilev==1) THEN
1561#include "vectorize.inc"
1562 DO ii=1,nmn
1563 j=msr(ii)
1564 adm(j) = adm(j)/max(mmass(ii),em20)
1565 ENDDO
1566 ENDIF
1567C
1568 RETURN
1569 END
1570!||====================================================================
1571!|| i2mzerop ../engine/source/interfaces/interf/i2for3p.F
1572!||--- called by ------------------------------------------------------
1573!|| intti2f ../engine/source/interfaces/interf/intti2f.f
1574!||====================================================================
1575 SUBROUTINE i2mzerop(FSKYI2,I0 ,NIR ,I2SIZE,IADI2,
1576 2 NSN ,NSV,WEIGHT)
1577C-----------------------------------------------
1578C I m p l i c i t T y p e s
1579C-----------------------------------------------
1580#include "implicit_f.inc"
1581C-----------------------------------------------
1582C D u m m y A r g u m e n t s
1583C-----------------------------------------------
1584 INTEGER I0,NIR,I2SIZE,NSN,
1585 . iadi2(nir,*),nsv(*),weight(*)
1586C REAL
1587 my_real
1588 . fskyi2(i2size,*)
1589C-----------------------------------------------
1590C L o c a l V a r i a b l e s
1591C-----------------------------------------------
1592 INTEGER II,I,NN
1593C-----------------------------------------------
1594C
1595 DO ii=1,nsn
1596 i=nsv(ii)
1597 IF (weight(i)==1) THEN
1598 i0 = i0 + 1
1599 nn = iadi2(1,i0)
1600 fskyi2(6,nn) = zero
1601 fskyi2(7,nn) = zero
1602 fskyi2(8,nn) = zero
1603 fskyi2(9,nn) = zero
1604 fskyi2(10,nn)= zero
1605 nn = iadi2(2,i0)
1606 fskyi2(6,nn) = zero
1607 fskyi2(7,nn) = zero
1608 fskyi2(8,nn) = zero
1609 fskyi2(9,nn) = zero
1610 fskyi2(10,nn)= zero
1611 nn = iadi2(3,i0)
1612 fskyi2(6,nn) = zero
1613 fskyi2(7,nn) = zero
1614 fskyi2(8,nn) = zero
1615 fskyi2(9,nn) = zero
1616 fskyi2(10,nn)= zero
1617 nn = iadi2(4,i0)
1618 fskyi2(6,nn) = zero
1619 fskyi2(7,nn) = zero
1620 fskyi2(8,nn) = zero
1621 fskyi2(9,nn) = zero
1622 fskyi2(10,nn)= zero
1623 ENDIF
1624 ENDDO
1625C
1626 RETURN
1627 END
1628!||====================================================================
1629!|| i2skip ../engine/source/interfaces/interf/i2for3p.F
1630!||--- called by ------------------------------------------------------
1631!|| intti1 ../engine/source/interfaces/interf/intti1.F
1632!||====================================================================
1633 SUBROUTINE i2skip(NSN ,NSV ,WEIGHT,I0 )
1634C-----------------------------------------------
1635C I m p l i c i t T y p e s
1636C-----------------------------------------------
1637#include "implicit_f.inc"
1638C-----------------------------------------------
1639C D u m m y A r g u m e n t s
1640C-----------------------------------------------
1641 INTEGER NSN, I0, NSV(*), WEIGHT(*)
1642C REAL
1643C-----------------------------------------------
1644C L o c a l V a r i a b l e s
1645C-----------------------------------------------
1646 INTEGER I, II
1647C REAL
1648C-----------------------------------------------
1649 DO ii=1,nsn
1650 i=nsv(ii)
1651 IF(i>0)THEN
1652 IF (weight(i)==1) THEN
1653 i0=i0+1
1654 END IF
1655 ELSEIF(i<0)THEN
1656 IF (weight(-i)==1) THEN
1657 i0=i0+1
1658 END IF
1659 END IF
1660 END DO
1661C
1662 RETURN
1663 END
my_real
#define my_real
Definition cppsort.cpp:32
i2mom3pn
subroutine i2mom3pn(nsn, nmn, ar, irect, crst, msr, nsv, irtl, in, ms, a, x, weight, stifr, fskyi2, stifn, iadi2, i0, nir, i2size, idel2, smass, siner, miner, adi, h3d_data, csts_bis)
Definition i2for3p.F:726
i2mzerop
subroutine i2mzerop(fskyi2, i0, nir, i2size, iadi2, nsn, nsv, weight)
Definition i2for3p.F:1577
i2for3p
subroutine i2for3p(nsn, nmn, a, crst, msr, nsv, ms, weight, stifn, mmass, fskyi2, iadi2, i0, nir, i2size, irect, x, v, fsav, fncont, irtl, h3d_data, csts_bis, fncontp, ftcontp)
Definition i2for3p.F:295
i2skip
subroutine i2skip(nsn, nsv, weight, i0)
Definition i2for3p.F:1634
i2for3pn
subroutine i2for3pn(nsn, nmn, a, crst, nsv, ms, weight, stifn, mmass, fskyi2, iadi2, i0, nir, i2size, idel2, smass, irect, x, v, fsav, fncont, irtl, h3d_data, csts_bis, fncontp, ftcontp)
Definition i2for3p.F:40
i2fomo3p
subroutine i2fomo3p(nsn, nmn, a, irect, dpara, msr, nsv, irtl, ms, weight, ar, in, x, stifn, stifr, fskyi2, iadi2, ilev, dmast, adm, mmass, i0, nir, i2size, idel2, smass, siner, v, crst, fsav, fncont, h3d_data, fncontp, ftcontp)
Definition i2for3p.F:1236
i2for3po
subroutine i2for3po(nsn, nmn, a, crst, msr, nsv, ms, weight, stifn, mmass, fskyi2, iadi2, i0, nir, i2size, irect, x, v, fsav, fncont, irtl, h3d_data, csts_bis, fncontp, ftcontp)
Definition i2for3p.F:538
i2mom3p
subroutine i2mom3p(nsn, nmn, ar, irect, crst, msr, nsv, irtl, in, ms, a, x, weight, stifr, fskyi2, iadi2, i0, nir, i2size, stifn, csts_bis)
Definition i2for3p.F:1046
i2forces
subroutine i2forces(x, fs, fx, fy, fz, irect, nir, fsav, fncont, fncontp, ftcontp, weight, h3d_data, nsl, h)
Definition i2forces.F:52
i2forces_2d
subroutine i2forces_2d(x, fs, fx, fy, fz, irect, nir, fsav, fncont, fncontp, ftcontp, weight, h3d_data, nsl, h)
Definition i2forces_2D.F:34
intti2f
subroutine intti2f(ipari, x, v, a, vr, ar, ms, in, weight, stifn, stifr, fskyi2, iadi2, i2msch, dmast, adm, i0, nir, i2size, adi, igeo, bufgeo, fsav, fncont, nodnx_sms, dmint2, sav_for_pena, ms_pena, dt2t, neltst, ityptst, intbuf_tab, temp, fthe, ftheskyi2, condn, condnskyi2, itab, sav_iner_poff, h3d_data, t2fac_sms, fncontp, ftcontp, idt_therm, theaccfact)
Definition intti2f.F:70
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:308