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