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