OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
bamom2.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 bamom2 (pm, v, w, 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

◆ bamom2()

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