OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
xbilan3.F File Reference
#include "implicit_f.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "scr23_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine xbilan3 (nx, kxx, ixx, x, v, vr, umass, uiner, forc, torq, keusr, eusr, eint, partsav, ipart, gresav, grth, igrth, igre)

Function/Subroutine Documentation

◆ xbilan3()

subroutine xbilan3 ( integer nx,
integer, dimension(nixx) kxx,
integer, dimension(*) ixx,
x,
v,
vr,
umass,
uiner,
forc,
torq,
integer keusr,
eusr,
eint,
partsav,
integer ipart,
gresav,
integer, dimension(*) grth,
integer, dimension(*) igrth,
integer, intent(in) igre )

Definition at line 28 of file xbilan3.F.

34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C C o m m o n B l o c k s
40C-----------------------------------------------
41#include "com08_c.inc"
42#include "param_c.inc"
43#include "scr23_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER, INTENT(IN) :: IGRE
48 INTEGER KXX(NIXX),IXX(*),NX,KEUSR,IPART,GRTH(*),IGRTH(*)
49C REAL
50 my_real
51 . x(3,*),v(3,*),vr(3,*),umass(*), uiner(*),forc(3,*),
52 . torq(3,*),eusr,eint,partsav(npsav,*),gresav(npsav,*)
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER I, K, IP, I1, IADNOD,J
57C REAL
58 my_real
59 . ems, xi
60C--------------------------------------------
61 iadnod=kxx(4)
62 IF (keusr==0) THEN
63 DO k=1,nx
64 i1 = ixx(iadnod+k-1)
65 ems=umass(k)
66 xi =uiner(k)
67C ENERGY has not been provided by user routine.
68C Integration en rectangle ..
69 eint = eint
70 . -dt1*(v(1,i1)*forc(1,k)+v(2,i1)*forc(2,k)+v(3,i1)*forc(3,k)
71 . +vr(1,i1)*torq(1,k)+vr(2,i1)*torq(2,k)+vr(3,i1)*torq(3,k))
72 ip=ipart
73 partsav(2,ip)=partsav(2,ip) + half * ems *
74 . (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))
75 partsav(3,ip)=partsav(3,ip) + ems*v(1,i1)
76 partsav(4,ip)=partsav(4,ip) + ems*v(2,i1)
77 partsav(5,ip)=partsav(5,ip) + ems*v(3,i1)
78 partsav(6,ip)=partsav(6,ip) + ems
79 partsav(7,ip)=partsav(7,ip) + half * xi *
80 . (vr(1,i1)*vr(1,i1)+vr(2,i1)*vr(2,i1)+vr(3,i1)*vr(3,i1))
81 ENDDO
82 IF (igre /= 0) THEN
83 IF (igrth(1) /= igrth(2)) THEN
84 DO j = igrth(1),igrth(2)-1
85 gresav(1,grth(j)) = gresav(1,grth(j)) + eint
86 gresav(2,grth(j)) = gresav(2,grth(j)) + half * ems *
87 . (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))
88 gresav(3,grth(j)) = gresav(3,grth(j)) + ems*v(1,i1)
89 gresav(4,grth(j)) = gresav(4,grth(j)) + ems*v(2,i1)
90 gresav(5,grth(j)) = gresav(5,grth(j)) + ems*v(3,i1)
91 gresav(6,grth(j)) = gresav(6,grth(j)) + ems
92 ENDDO
93 ENDIF
94 ENDIF
95 ELSE
96 DO k=1,nx
97 i1 = ixx(iadnod+k-1)
98 ems=umass(k)
99 xi =uiner(k)
100 ip=ipart
101 partsav(2,ip)=partsav(2,ip) + half * ems *
102 . (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))
103 partsav(3,ip)=partsav(3,ip) + ems*v(1,i1)
104 partsav(4,ip)=partsav(4,ip) + ems*v(2,i1)
105 partsav(5,ip)=partsav(5,ip) + ems*v(3,i1)
106 partsav(6,ip)=partsav(6,ip) + ems
107 partsav(7,ip)=partsav(7,ip) + half * xi *
108 . (vr(1,i1)*vr(1,i1)+vr(2,i1)*vr(2,i1)+vr(3,i1)*vr(3,i1))
109 ENDDO
110 IF (igre /= 0) THEN
111 IF (igrth(1) /= igrth(2)) THEN
112 DO j = igrth(1),igrth(2)-1
113 gresav(1,grth(j)) = gresav(1,grth(j)) + eint
114 gresav(2,grth(j)) = gresav(2,grth(j)) + half * ems *
115 . (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))
116 gresav(3,grth(j)) = gresav(3,grth(j)) + ems*v(1,i1)
117 gresav(4,grth(j)) = gresav(4,grth(j)) + ems*v(2,i1)
118 gresav(5,grth(j)) = gresav(5,grth(j)) + ems*v(3,i1)
119 gresav(6,grth(j)) = gresav(6,grth(j)) + ems
120 ENDDO
121 ENDIF
122 ENDIF
123 eint=eusr
124 ENDIF
125 partsav(1,ip)=partsav(1,ip) + eint
126C
127 RETURN
my_real
#define my_real
Definition cppsort.cpp:32