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

Go to the source code of this file.

Functions/Subroutines

subroutine bemom2 (pm, v, rho, alph, alphc, fill, b11, b12, b13, b14, b21, b22, b23, b24, py1, py2, pz1, pz2, aire, mat, nc1, nc2, nc3, nc4, nel)

Function/Subroutine Documentation

◆ bemom2()

subroutine bemom2 ( pm,
v,
rho,
alph,
alphc,
fill,
b11,
b12,
b13,
b14,
b21,
b22,
b23,
b24,
py1,
py2,
pz1,
pz2,
aire,
integer, dimension(*) mat,
integer, dimension(*) nc1,
integer, dimension(*) nc2,
integer, dimension(*) nc3,
integer, dimension(*) nc4,
integer, intent(in) nel )

Definition at line 28 of file bemom2.F.

36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C G l o b a l P a r a m e t e r s
42C-----------------------------------------------
43#include "mvsiz_p.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com08_c.inc"
48#include "param_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER, INTENT(IN) :: NEL
54 . pm(npropm,*), v(3,*), rho(*), alph(*), alphc(*), fill(*)
56 . b11(*), b12(*), b13(*), b14(*),
57 . b21(*), b22(*), b23(*), b24(*),
58 . py1(*), py2(*), pz1(*), pz2(*), aire(*)
59
60 INTEGER MAT(*), NC1(*), NC2(*), NC3(*), NC4(*)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I, NV
66 . gamma(mvsiz), xms(mvsiz),
67 . vy1(mvsiz), vy2(mvsiz), vy3(mvsiz), vy4(mvsiz), vz1(mvsiz),
68 . vz2(mvsiz), vz3(mvsiz), vz4(mvsiz), vy13(mvsiz), vy24(mvsiz), vz13(mvsiz), vz24(mvsiz),
69 . dyy(mvsiz), dzz(mvsiz), dyz(mvsiz), dzy(mvsiz), vdy(mvsiz), vdz(mvsiz), f1(mvsiz), f2(mvsiz),
70 . a1(mvsiz), a2(mvsiz), g1(mvsiz), g2(mvsiz), ff1, ff2, ff3, ff4, dvy, dvz
71C-----------------------------------------------
72C-------------------------------
73 DO i=1,nel
74 xms(i) =fourth*rho(i)*alph(i)
75 gamma(i)= pm(15,mat(i))
76 ENDDO
77C-------------------------------
78 DO i=1,nel
79 vy1(i)=v(2,nc1(i))
80 vz1(i)=v(3,nc1(i))
81 vy2(i)=v(2,nc2(i))
82 vz2(i)=v(3,nc2(i))
83 vy3(i)=v(2,nc3(i))
84 vz3(i)=v(3,nc3(i))
85 vy4(i)=v(2,nc4(i))
86 vz4(i)=v(3,nc4(i))
87 ENDDO
88
89 DO i=1,nel
90 vy13(i)=vy1(i)-vy3(i)
91 vy24(i)=vy2(i)-vy4(i)
92 vz13(i)=vz1(i)-vz3(i)
93 vz24(i)=vz2(i)-vz4(i)
94 ENDDO
95
96 DO i=1,nel
97 dyy(i)=py1(i)*vy13(i)+py2(i)*vy24(i)
98 dzz(i)=pz1(i)*vz13(i)+pz2(i)*vz24(i)
99 dyz(i)=pz1(i)*vy13(i)+pz2(i)*vy24(i)
100 dzy(i)=py1(i)*vz13(i)+py2(i)*vz24(i)
101 ENDDO
102C-----------------------------------------------
103C CALCUL DE (V MATIERE - V MAILLAGE) MOYEN
104C---------------------------------------
105 DO i=1,nel
106 vdy(i)=fourth*(vy1(i)+vy2(i)+vy3(i)+vy4(i))
107 vdz(i)=fourth*(vz1(i)+vz2(i)+vz3(i)+vz4(i))
108 ENDDO
109
110 DO i=1,nel
111 f1(i) = (vdy(i)*dyy(i)+vdz(i)*dyz(i))*xms(i)
112 f2(i) = (vdy(i)*dzy(i)+vdz(i)*dzz(i))*xms(i)
113 ENDDO
114
115 DO i=1,nel
116 a1(i) = py1(i)*vdy(i)+pz1(i)*vdz(i)
117 a2(i) = py2(i)*vdy(i)+pz2(i)*vdz(i)
118 ENDDO
119
120 DO i=1,nel
121 g1(i) = sign(gamma(i),a1(i))
122 g2(i) = sign(gamma(i),a2(i))
123 ENDDO
124
125 DO i=1,nel
126 b11(i) = (one+g1(i))*f1(i)
127 b12(i) = (one+g2(i))*f1(i)
128 b13(i) = (one-g1(i))*f1(i)
129 b14(i) = (one-g2(i))*f1(i)
130
131 b21(i) = (one+g1(i))*f2(i)
132 b22(i) = (one+g2(i))*f2(i)
133 b23(i) = (one-g1(i))*f2(i)
134 b24(i) = (one-g2(i))*f2(i)
135 ENDDO
136
137 DO i=1,nel
138 xms(i) =fourth*rho(i)*aire(i)*(one-alph(i)) / max(em15,dt1)
139 ENDDO
140
141 DO i=1,nel
142 IF(alph(i)<one
143 . .AND.alph(i)>zero
144 . .AND.alphc(i)==zero
145 . .AND.dt1>zero)THEN
146
147 ff1=fill(nc1(i))
148 ff2=fill(nc2(i))
149 ff3=fill(nc3(i))
150 ff4=fill(nc4(i))
151C 1
152 IF(ff1<zero)THEN
153 nv=0
154 dvy=zero
155 dvz=zero
156 IF(ff2>zero)THEN
157 nv=nv+1
158 dvy=dvy+(v(2,nc2(i))-v(2,nc1(i)))
159 dvz=dvz+(v(3,nc2(i))-v(3,nc1(i)))
160 ENDIF
161 IF(ff4>zero)THEN
162 nv=nv+1
163 dvy=dvy+(v(2,nc4(i))-v(2,nc1(i)))
164 dvz=dvz+(v(3,nc4(i))-v(3,nc1(i)))
165 ENDIF
166 IF(nv==0.AND.ff3>zero)THEN
167 nv=nv+1
168 dvy=dvy+(v(2,nc3(i))-v(2,nc1(i)))
169 dvz=dvz+(v(3,nc3(i))-v(3,nc1(i)))
170 ENDIF
171 b11(i)=b11(i)-xms(i)*dvy/max(1,nv)
172 b21(i)=b21(i)-xms(i)*dvz/max(1,nv)
173 ENDIF
174C 2
175 IF(ff2<zero)THEN
176 nv=0
177 dvy=zero
178 dvz=zero
179 IF(ff3>zero)THEN
180 nv=nv+1
181 dvy=dvy+(v(2,nc3(i))-v(2,nc2(i)))
182 dvz=dvz+(v(3,nc3(i))-v(3,nc2(i)))
183 ENDIF
184 IF(ff1>zero)THEN
185 nv=nv+1
186 dvy=dvy+(v(2,nc1(i))-v(2,nc2(i)))
187 dvz=dvz+(v(3,nc1(i))-v(3,nc2(i)))
188 ENDIF
189 IF(nv==0.AND.ff4>zero)THEN
190 nv=nv+1
191 dvy=dvy+(v(2,nc4(i))-v(2,nc2(i)))
192 dvz=dvz+(v(3,nc4(i))-v(3,nc2(i)))
193 ENDIF
194 b12(i)=b12(i)-xms(i)*dvy/max(1,nv)
195 b22(i)=b22(i)-xms(i)*dvz/max(1,nv)
196 ENDIF
197C 3
198 IF(ff3<zero)THEN
199 nv=0
200 dvy=zero
201 dvz=zero
202 IF(ff4>zero)THEN
203 nv=nv+1
204 dvy=dvy+(v(2,nc4(i))-v(2,nc3(i)))
205 dvz=dvz+(v(3,nc4(i))-v(3,nc3(i)))
206 ENDIF
207 IF(ff2>zero)THEN
208 nv=nv+1
209 dvy=dvy+(v(2,nc2(i))-v(2,nc3(i)))
210 dvz=dvz+(v(3,nc2(i))-v(3,nc3(i)))
211 ENDIF
212 IF(nv==0.AND.ff1>zero)THEN
213 nv=nv+1
214 dvy=dvy+(v(2,nc1(i))-v(2,nc3(i)))
215 dvz=dvz+(v(3,nc1(i))-v(3,nc3(i)))
216 ENDIF
217 b13(i)=b13(i)-xms(i)*dvy/max(1,nv)
218 b23(i)=b23(i)-xms(i)*dvz/max(1,nv)
219 ENDIF
220C 4
221 IF(ff4<zero)THEN
222 nv=0
223 dvy=zero
224 dvz=zero
225 IF(ff1>zero)THEN
226 nv=nv+1
227 dvy=dvy+(v(2,nc1(i))-v(2,nc4(i)))
228 dvz=dvz+(v(3,nc1(i))-v(3,nc4(i)))
229 ENDIF
230 IF(ff3>zero)THEN
231 nv=nv+1
232 dvy=dvy+(v(2,nc3(i))-v(2,nc4(i)))
233 dvz=dvz+(v(3,nc3(i))-v(3,nc4(i)))
234 ENDIF
235 IF(nv==0.AND.ff2>zero)THEN
236 nv=nv+1
237 dvy=dvy+(v(2,nc2(i))-v(2,nc4(i)))
238 dvz=dvz+(v(3,nc2(i))-v(3,nc4(i)))
239 ENDIF
240 b14(i)=b14(i)-xms(i)*dvy/max(1,nv)
241 b24(i)=b24(i)-xms(i)*dvz/max(1,nv)
242 ENDIF
243 ENDIF
244 ENDDO !next I
245 RETURN
#define my_real
Definition cppsort.cpp:32
#define max(a, b)
Definition macros.h:21