OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
bemom2.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!|| bemom2 ../engine/source/ale/bimat/bemom2.F
25!||--- called by ------------------------------------------------------
26!|| bforc2 ../engine/source/ale/bimat/bforc2.F
27!||====================================================================
28 SUBROUTINE bemom2(
29 1 PM, V, RHO, ALPH,
30 2 ALPHC, FILL, B11, B12,
31 3 B13, B14, B21, B22,
32 4 B23, B24, PY1, PY2,
33 5 PZ1, PZ2, AIRE, MAT,
34 6 NC1, NC2, NC3, NC4,
35 7 NEL)
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,*), RHO(*), ALPH(*), ALPHC(*), FILL(*)
55 my_real
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
65 my_real
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
246 END
bemom2
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)
Definition bemom2.F:36
max
#define max(a, b)
Definition macros.h:21