OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
bcumu2.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!|| bcumu2 ../engine/source/ale/bimat/bcumu2.F
25!||--- called by ------------------------------------------------------
26!|| bforc2 ../engine/source/ale/bimat/bforc2.F
27!||====================================================================
28 SUBROUTINE bcumu2(ALPH,E,
29 . SIG,EINT,RHO,BULK,BULKT,
30 . SIGT,EINTT,RHOT,TEMPT,TEMP,
31 . PLAST,PLAS,BFRACT,BFRAC,
32 . F11, F12, F21, F22, AX1,AX2,
33 . T11,T12,T13,T14,T21,T22,T23,T24,
34 . B11,B12,B13,B14,B21,B22,B23,B24,
35 . NC1,NC2,NC3,NC4, STI,STIFN,
36 . L_TEMP, L_PLA,L_BFRAC, L_BULK,NEL)
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C D u m m y A r g u m e n t s
43C-----------------------------------------------
44 INTEGER NC1(*), NC2(*), NC3(*), NC4(*), L_TEMP, L_PLA, L_BFRAC,L_BULK,NEL
45 my_real
46 . ALPH(*), E(3,*) , SIG(NEL,6), EINT(*) ,
47 . RHO(*) , BULK(*) , SIGT(NEL,6), EINTT(*) , RHOT(*) , TEMPT(*),
48 . TEMP(*), PLAST(*), PLAS(*) , BFRACT(*), BFRAC(*), BULKT(*)
49 my_real
50 . B11(*), B12(*), B13(*), B14(*),
51 . B21(*), B22(*), B23(*), B24(*)
52 my_real
53 . f11(*), f12(*), f21(*), f22(*), ax1(*), ax2(*),
54 . t11(*), t12(*), t13(*), t14(*),
55 . t21(*), t22(*), t23(*), t24(*),sti(*),stifn(*)
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "vect01_c.inc"
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER I, J
64 my_real
65 . ALPHT, ALPHX
66C-----------------------------------------------
67 IF(JALE+JEUL==0.OR.mtn==11) THEN
68 DO i=lft,llt
69 b11(i)=zero
70 b12(i)=zero
71 b13(i)=zero
72 b14(i)=zero
73 b21(i)=zero
74 b22(i)=zero
75 b23(i)=zero
76 b24(i)=zero
77 ENDDO
78 ENDIF
79C-------------------------
80C ASSEMBLE
81C-------------------------
82 DO i=lft,llt
83 alpht=one
84 alphx=alph(i)
85 e(2,nc1(i)) = e(2,nc1(i))-ax1(i)+alphx*(-t11(i)-f11(i))-alpht*b11(i)
86 e(3,nc1(i)) = e(3,nc1(i))+ax2(i)+alphx*(-t21(i)-f21(i))-alpht*b21(i)
87 stifn(nc1(i)) = stifn(nc1(i))+sti(i)
88 e(2,nc2(i)) = e(2,nc2(i))-ax1(i)+alphx*(-t12(i)-f12(i))-alpht*b12(i)
89 e(3,nc2(i)) = e(3,nc2(i))+ax2(i)+alphx*(-t22(i)-f22(i))-alpht*b22(i)
90 stifn(nc2(i)) = stifn(nc2(i))+sti(i)
91 e(2,nc3(i)) = e(2,nc3(i))-ax1(i)+alphx*(-t13(i)+f11(i))-alpht*b13(i)
92 e(3,nc3(i)) = e(3,nc3(i))+ax2(i)+alphx*(-t23(i)+f21(i))-alpht*b23(i)
93 stifn(nc3(i)) = stifn(nc3(i))+sti(i)
94 e(2,nc4(i)) = e(2,nc4(i))-ax1(i)+alphx*(-t14(i)+f12(i))-alpht*b14(i)
95 e(3,nc4(i)) = e(3,nc4(i))+ax2(i)+alphx*(-t24(i)+f22(i))-alpht*b24(i)
96 stifn(nc4(i)) = stifn(nc4(i))+sti(i)
97 ENDDO
98
99 DO i=lft,llt
100 IF(alph(i)==zero)THEN
101 DO j=1,6
102 sig(i,j)= zero
103 ENDDO
104 eint(i) = zero
105 rho(i) = zero
106 bulk(i) = zero
107 ENDIF
108 ENDDO
109
110 DO i=lft,llt
111 DO j=1,6
112 sigt(i,j)=sigt(i,j)+sig(i,j)*alph(i)
113 ENDDO
114 eintt(i)=eintt(i)+eint(i)*alph(i)
115 rhot(i) =rhot(i)+rho(i)*alph(i)
116 ENDDO
117
118 IF(l_temp>0)THEN
119 DO i=lft,llt
120 tempt(i)=tempt(i)+temp(i)*alph(i)
121 ENDDO
122 ENDIF
123
124 IF(l_pla>0)THEN
125 DO i=lft,llt
126 plast(i)=plast(i)+plas(i)*alph(i)
127 ENDDO
128 ENDIF
129
130 IF(l_bfrac>0)THEN
131 DO i=lft,llt
132 bfract(i)=bfract(i)+bfrac(i)*alph(i)
133 ENDDO
134 ENDIF
135
136 IF(l_bulk>0)THEN
137 DO i=lft,llt
138 bulkt(i)=bulkt(i)+bulk(i)*alph(i)
139 ENDDO
140 ENDIF
141
142 RETURN
143 END
144
145!||====================================================================
146!|| bcumu2p ../engine/source/ale/bimat/bcumu2.F
147!||--- called by ------------------------------------------------------
148!|| bforc2 ../engine/source/ale/bimat/bforc2.F
149!||====================================================================
150 SUBROUTINE bcumu2p(ALPH,
151 . SIG,EINT,RHO,BULK,BULKT,
152 . SIGT,EINTT,RHOT,TEMPT,TEMP,
153 . PLAST,PLAS,BFRACT,BFRAC,
154 . F11, F12, F21, F22, AX1,AX2,
155 . T11,T12,T13,T14,T21,T22,T23,T24,
156 . B11,B12,B13,B14,B21,B22,B23,B24,
157 . FSKY,FSKYV,IADQ,STI,
158 . L_TEMP, L_PLA, L_BFRAC,L_BULK,NEL)
159C-----------------------------------------------
160C I m p l i c i t T y p e s
161C-----------------------------------------------
162#include "implicit_f.inc"
163C-----------------------------------------------
164C C o m m o n B l o c k s
165C-----------------------------------------------
166#include "parit_c.inc"
167C-----------------------------------------------
168C D u m m y A r g u m e n t s
169C-----------------------------------------------
170 INTEGER IADQ(4,*),L_TEMP, L_PLA,L_BFRAC,
171 . L_BULK,NEL
172 my_real
173 . ALPH(*),SIG(NEL,6), EINT(*),
174 . RHO(*), BULK(*), SIGT(NEL,6), EINTT(*), RHOT(*),TEMPT(*),
175 . TEMP(*),PLAST(*), PLAS(*), BFRACT(*), BFRAC(*), BULKT(*)
176 my_real
177 . B11(*), B12(*), B13(*), B14(*),
178 . B21(*), B22(*), B23(*), B24(*)
179 my_real
180 . F11(*), F12(*), F21(*), F22(*), AX1(*), AX2(*),
181 . T11(*), T12(*), T13(*), T14(*),
182 . T21(*), T22(*), T23(*), T24(*),
183 . FSKYV(LSKY,8),FSKY(8,LSKY),STI(*)
184C-----------------------------------------------
185C C o m m o n B l o c k s
186C-----------------------------------------------
187#include "vect01_c.inc"
188C-----------------------------------------------
189C L o c a l V a r i a b l e s
190C-----------------------------------------------
191 INTEGER I, J, II, K
192 my_real
193 . alpht, alphx
194C-----------------------------------------------
195 IF(jale+jeul==0.OR.mtn==11) THEN
196 DO i=lft,llt
197 b11(i)=zero
198 b12(i)=zero
199 b13(i)=zero
200 b14(i)=zero
201 b21(i)=zero
202 b22(i)=zero
203 b23(i)=zero
204 b24(i)=zero
205 ENDDO
206 ENDIF
207C-------------------------
208C ASSEMBLE
209C-------------------------
210 IF(ivector==1) THEN
211 DO i=lft,llt
212 alpht=one
213 alphx=alph(i)
214 ii=i+nft
215 k = iadq(1,ii)
216 fskyv(k,2)=-ax1(i)+alphx*(-t11(i)-f11(i))-alpht*b11(i)
217 fskyv(k,3)=+ax2(i)+alphx*(-t21(i)-f21(i))-alpht*b21(i)
218 fskyv(k,7)=sti(i)
219
220 k = iadq(2,ii)
221 fskyv(k,2)=-ax1(i)+alphx*(-t12(i)-f12(i))-alpht*b12(i)
222 fskyv(k,3)=+ax2(i)+alphx*(-t22(i)-f22(i))-alpht*b22(i)
223 fskyv(k,7)=sti(i)
224
225 k = iadq(3,ii)
226 fskyv(k,2)=-ax1(i)+alphx*(-t13(i)+f11(i))-alpht*b13(i)
227 fskyv(k,3)=+ax2(i)+alphx*(-t23(i)+f21(i))-alpht*b23(i)
228 fskyv(k,7)=sti(i)
229
230 k = iadq(4,ii)
231 fskyv(k,2)=-ax1(i)+alphx*(-t14(i)+f12(i))-alpht*b14(i)
232 fskyv(k,3)=+ax2(i)+alphx*(-t24(i)+f22(i))-alpht*b24(i)
233 fskyv(k,7)=sti(i)
234 ENDDO
235 ELSE
236 DO i=lft,llt
237 alpht=one
238 alphx=alph(i)
239 ii=i+nft
240 k = iadq(1,ii)
241 fsky(2,k)=-ax1(i)+alphx*(-t11(i)-f11(i))-alpht*b11(i)
242 fsky(3,k)=+ax2(i)+alphx*(-t21(i)-f21(i))-alpht*b21(i)
243 fsky(7,k)=sti(i)
244
245 k = iadq(2,ii)
246 fsky(2,k)=-ax1(i)+alphx*(-t12(i)-f12(i))-alpht*b12(i)
247 fsky(3,k)=+ax2(i)+alphx*(-t22(i)-f22(i))-alpht*b22(i)
248 fsky(7,k)=sti(i)
249
250 k = iadq(3,ii)
251 fsky(2,k)=-ax1(i)+alphx*(-t13(i)+f11(i))-alpht*b13(i)
252 fsky(3,k)=+ax2(i)+alphx*(-t23(i)+f21(i))-alpht*b23(i)
253 fsky(7,k)=sti(i)
254
255 k = iadq(4,ii)
256 fsky(2,k)=-ax1(i)+alphx*(-t14(i)+f12(i))-alpht*b14(i)
257 fsky(3,k)=+ax2(i)+alphx*(-t24(i)+f22(i))-alpht*b24(i)
258 fsky(7,k)=sti(i)
259 ENDDO
260 ENDIF
261
262 DO i=lft,llt
263 IF(alph(i)==zero)THEN
264 DO j=1,6
265 sig(i,j)=zero
266 ENDDO
267 eint(i)=zero
268 rho(i) =zero
269 bulk(i)=zero
270 ENDIF
271 ENDDO
272
273 DO i=lft,llt
274 DO j=1,6
275 sigt(i,j)=sigt(i,j)+sig(i,j)*alph(i)
276 ENDDO
277 eintt(i)=eintt(i)+eint(i)*alph(i)
278 rhot(i) =rhot(i)+rho(i)*alph(i)
279 ENDDO
280
281 IF(l_temp>0)THEN
282 DO i=lft,llt
283 tempt(i)=tempt(i)+temp(i)*alph(i)
284 ENDDO
285 ENDIF
286
287 IF(l_pla>0)THEN
288 DO i=lft,llt
289 plast(i)=plast(i)+plas(i)*alph(i)
290 ENDDO
291 ENDIF
292
293 IF(l_bfrac>0)THEN
294 DO i=lft,llt
295 bfract(i)=bfract(i)+bfrac(i)*alph(i)
296 ENDDO
297 ENDIF
298
299 IF(l_bulk>0)THEN
300 DO i=lft,llt
301 bulkt(i)=bulkt(i)+bulk(i)*alph(i)
302 ENDDO
303 ENDIF
304
305 RETURN
306 END
307
308!||====================================================================
309!|| bcumu2pa ../engine/source/ale/bimat/bcumu2.F
310!||--- called by ------------------------------------------------------
311!|| bforc2 ../engine/source/ale/bimat/bforc2.F
312!||====================================================================
313 SUBROUTINE bcumu2pa(ALPH,
314 . SIG,EINT,RHO,BULK,BULKT,
315 . SIGT,EINTT,RHOT,TEMPT,TEMP,
316 . PLAST,PLAS,BFRACT,BFRAC,
317 . F11, F12, F21, F22, AX1,AX2,
318 . T11,T12,T13,T14,T21,T22,T23,T24,
319 . B11,B12,B13,B14,B21,B22,B23,B24,
320 . FSKY,FSKYV,IADQ,STI,
321 . L_TEMP, L_PLA,L_BFRAC,L_BULK,NEL)
322C-----------------------------------------------
323C I m p l i c i t T y p e s
324C-----------------------------------------------
325#include "implicit_f.inc"
326C-----------------------------------------------
327C C o m m o n B l o c k s
328C-----------------------------------------------
329#include "parit_c.inc"
330C-----------------------------------------------
331C D u m m y A r g u m e n t s
332C-----------------------------------------------
333 INTEGER IADQ(4,*),L_TEMP,L_PLA,L_BFRAC,
334 . L_BULK,NEL
335 my_real
336 . ALPH(*), SIG(NEL,6), EINT(*),
337 . rho(*), bulk(*), sigt(nel,6), eintt(*), rhot(*),tempt(*),
338 . temp(*), plast(*), plas(*), bfract(*), bfrac(*),bulkt(*)
339 my_real
340 . b11(*), b12(*), b13(*), b14(*),
341 . b21(*), b22(*), b23(*), b24(*)
342 my_real
343 . f11(*), f12(*), f21(*), f22(*), ax1(*), ax2(*),
344 . t11(*), t12(*), t13(*), t14(*),
345 . t21(*), t22(*), t23(*), t24(*),
346 . fskyv(lsky,8),fsky(8,lsky),sti(*)
347C-----------------------------------------------
348C C o m m o n B l o c k s
349C-----------------------------------------------
350#include "vect01_c.inc"
351C-----------------------------------------------
352C L o c a l V a r i a b l e s
353C-----------------------------------------------
354 INTEGER I, J, II, K
355 my_real
356 . ALPHT, ALPHX
357C-----------------------------------------------
358 IF(jale+jeul==0.OR.mtn==11) THEN
359 DO i=lft,llt
360 b11(i)=zero
361 b12(i)=zero
362 b13(i)=zero
363 b14(i)=zero
364 b21(i)=zero
365 b22(i)=zero
366 b23(i)=zero
367 b24(i)=zero
368 ENDDO
369 ENDIF
370C-------------------------
371C ASSEMBLE
372C-------------------------
373 IF(ivector==1) THEN
374 DO i=lft,llt
375 alpht=one
376 alphx=alph(i)
377 ii=i+nft
378 k = iadq(1,ii)
379 fskyv(k,2)=fskyv(k,2)
380 . -ax1(i)+alphx*(-t11(i)-f11(i))-alpht*b11(i)
381 fskyv(k,3)=fskyv(k,3)
382 . +ax2(i)+alphx*(-t21(i)-f21(i))-alpht*b21(i)
383 fskyv(k,7)=fskyv(k,7)+sti(i)
384
385 k = iadq(2,ii)
386 fskyv(k,2)=fskyv(k,2)
387 . -ax1(i)+alphx*(-t12(i)-f12(i))-alpht*b12(i)
388 fskyv(k,3)=fskyv(k,3)
389 . +ax2(i)+alphx*(-t22(i)-f22(i))-alpht*b22(i)
390 fskyv(k,7)=fskyv(k,7)+sti(i)
391
392 k = iadq(3,ii)
393 fskyv(k,2)=fskyv(k,2)
394 . -ax1(i)+alphx*(-t13(i)+f11(i))-alpht*b13(i)
395 fskyv(k,3)=fskyv(k,3)
396 . +ax2(i)+alphx*(-t23(i)+f21(i))-alpht*b23(i)
397 fskyv(k,7)=fskyv(k,7)+sti(i)
398
399 k = iadq(4,ii)
400 fskyv(k,2)=fskyv(k,2)
401 . -ax1(i)+alphx*(-t14(i)+f12(i))-alpht*b14(i)
402 fskyv(k,3)=fskyv(k,3)
403 . +ax2(i)+alphx*(-t24(i)+f22(i))-alpht*b24(i)
404 fskyv(k,7)=fskyv(k,7)+sti(i)
405 ENDDO
406 ELSE
407 DO i=lft,llt
408 alpht=one
409 alphx=alph(i)
410 ii=i+nft
411 k = iadq(1,ii)
412 fsky(2,k)=fsky(2,k)
413 . -ax1(i)+alphx*(-t11(i)-f11(i))-alpht*b11(i)
414 fsky(3,k)=fsky(3,k)
415 . +ax2(i)+alphx*(-t21(i)-f21(i))-alpht*b21(i)
416 fsky(7,k)=fsky(7,k)+sti(i)
417
418 k = iadq(2,ii)
419 fsky(2,k)=fsky(2,k)
420 . -ax1(i)+alphx*(-t12(i)-f12(i))-alpht*b12(i)
421 fsky(3,k)=fsky(3,k)
422 . +ax2(i)+alphx*(-t22(i)-f22(i))-alpht*b22(i)
423 fsky(7,k)=fsky(7,k)+sti(i)
424
425 k = iadq(3,ii)
426 fsky(2,k)=fsky(2,k)
427 . -ax1(i)+alphx*(-t13(i)+f11(i))-alpht*b13(i)
428 fsky(3,k)=fsky(3,k)
429 . +ax2(i)+alphx*(-t23(i)+f21(i))-alpht*b23(i)
430 fsky(7,k)=fsky(7,k)+sti(i)
431
432 k = iadq(4,ii)
433 fsky(2,k)=fsky(2,k)
434 . -ax1(i)+alphx*(-t14(i)+f12(i))-alpht*b14(i)
435 fsky(3,k)=fsky(3,k)
436 . +ax2(i)+alphx*(-t24(i)+f22(i))-alpht*b24(i)
437 fsky(7,k)=fsky(7,k)+sti(i)
438 ENDDO
439 ENDIF
440
441 DO i=lft,llt
442 IF(alph(i)==zero)THEN
443 DO j=1,6
444 sig(i,j)=zero
445 ENDDO
446 eint(i)=zero
447 rho(i) =zero
448 bulk(i)=zero
449 ENDIF
450 ENDDO
451
452 DO i=lft,llt
453 DO j=1,6
454 sigt(i,j)=sigt(i,j)+sig(i,j)*alph(i)
455 ENDDO
456 eintt(i)=eintt(i)+eint(i)*alph(i)
457 rhot(i) =rhot(i)+rho(i)*alph(i)
458 ENDDO
459
460 IF(l_temp>0)THEN
461 DO i=lft,llt
462 tempt(i)=tempt(i)+temp(i)*alph(i)
463 ENDDO
464 ENDIF
465
466 IF(l_pla>0)THEN
467 DO i=lft,llt
468 plast(i)=plast(i)+plas(i)*alph(i)
469 ENDDO
470 ENDIF
471
472 IF(l_bfrac>0)THEN
473 DO i=lft,llt
474 bfract(i)=bfract(i)+bfrac(i)*alph(i)
475 ENDDO
476 ENDIF
477
478 IF(l_bulk>0)THEN
479 DO i=lft,llt
480 bulkt(i)=bulkt(i)+bulk(i)*alph(i)
481 ENDDO
482 ENDIF
483
484 RETURN
485 END
bcumu2pa
subroutine bcumu2pa(alph, sig, eint, rho, bulk, bulkt, sigt, eintt, rhot, tempt, temp, plast, plas, bfract, bfrac, f11, f12, f21, f22, ax1, ax2, t11, t12, t13, t14, t21, t22, t23, t24, b11, b12, b13, b14, b21, b22, b23, b24, fsky, fskyv, iadq, sti, l_temp, l_pla, l_bfrac, l_bulk, nel)
Definition bcumu2.F:322
bcumu2
subroutine bcumu2(alph, e, sig, eint, rho, bulk, bulkt, sigt, eintt, rhot, tempt, temp, plast, plas, bfract, bfrac, f11, f12, f21, f22, ax1, ax2, t11, t12, t13, t14, t21, t22, t23, t24, b11, b12, b13, b14, b21, b22, b23, b24, nc1, nc2, nc3, nc4, sti, stifn, l_temp, l_pla, l_bfrac, l_bulk, nel)
Definition bcumu2.F:37
bcumu2p
subroutine bcumu2p(alph, sig, eint, rho, bulk, bulkt, sigt, eintt, rhot, tempt, temp, plast, plas, bfract, bfrac, f11, f12, f21, f22, ax1, ax2, t11, t12, t13, t14, t21, t22, t23, t24, b11, b12, b13, b14, b21, b22, b23, b24, fsky, fskyv, iadq, sti, l_temp, l_pla, l_bfrac, l_bulk, nel)
Definition bcumu2.F:159