OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
multi_var2buf.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "task_c.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine multi_var2buf (itask, iparg, multi_fvm, elbuf_tab)

Function/Subroutine Documentation

◆ multi_var2buf()

subroutine multi_var2buf ( integer, intent(in) itask,
integer, dimension(nparg, *), intent(in) iparg,
type(multi_fvm_struct), intent(inout) multi_fvm,
type(elbuf_struct_), dimension(ngroup), intent(inout), target elbuf_tab )

Definition at line 31 of file multi_var2buf.F.

32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE elbufdef_mod
36 USE multi_fvm_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44C NPARG
45#include "param_c.inc"
46C NGROUP
47#include "com01_c.inc"
48C NTHREAD
49#include "task_c.inc"
50C MVSIZ
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER, INTENT(IN) :: ITASK, IPARG(NPARG, *)
56 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
57 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP), INTENT(INOUT) :: ELBUF_TAB
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER :: NBMAT, IMAT, II, I, NG, MATLAW, NEL, NFT
62 my_real :: vol, cumul_alpha(mvsiz)
63 TYPE(G_BUFEL_), POINTER :: GBUF
64 TYPE(L_BUFEL_), POINTER :: LBUF
65
66 nbmat = multi_fvm%NBMAT
67 DO ng = itask + 1, ngroup, nthread
68 matlaw = iparg(1, ng)
69 IF (matlaw == 151) THEN
70 nel = iparg(2, ng)
71 nft = iparg(3, ng)
72 gbuf => elbuf_tab(ng)%GBUF
73 DO ii = 1, nel
74 i = ii + nft
75C Mass density
76 gbuf%RHO(ii) = multi_fvm%RHO(i)
77C Volumic internal energy
78 gbuf%EINT(ii) = multi_fvm%EINT(i)
79C Velocity
80 gbuf%MOM(ii + 0 * nel) = multi_fvm%VEL(1, i)
81 gbuf%MOM(ii + 1 * nel) = multi_fvm%VEL(2, i)
82 gbuf%MOM(ii + 2 * nel) = multi_fvm%VEL(3, i)
83 gbuf%SIG(ii + 0 * nel) = -multi_fvm%PRES(i)
84 gbuf%SIG(ii + 1 * nel) = -multi_fvm%PRES(i)
85 gbuf%SIG(ii + 2 * nel) = -multi_fvm%PRES(i)
86 ENDDO
87 IF (nbmat > 1) THEN
88 cumul_alpha(1:nel) = zero
89C Fill partial values
90 DO imat = 1, nbmat
91 DO ii = 1, nel
92 i = ii + nft
93 cumul_alpha(ii) = cumul_alpha(ii) + multi_fvm%PHASE_ALPHA(imat, i)
94 ENDDO
95 ENDDO
96 DO imat = 1, nbmat
97 lbuf => elbuf_tab(ng)%BUFLY(imat)%LBUF(1, 1, 1)
98 DO ii = 1, nel
99 i = ii + nft
100 vol = gbuf%VOL(ii)
101C Normalize volumic fraction
102 multi_fvm%PHASE_ALPHA(imat, i) = multi_fvm%PHASE_ALPHA(imat, i) /
103 . cumul_alpha(ii)
104C Volume
105 lbuf%VOL(ii) = multi_fvm%PHASE_ALPHA(imat, i) * vol
106C Mass density
107 lbuf%RHO(ii) = multi_fvm%PHASE_RHO(imat, i)
108C Volumic internal energy
109 lbuf%EINT(ii) = multi_fvm%PHASE_EINT(imat, i)
110C PRessure
111 lbuf%SIG(ii + 0 * nel) = -multi_fvm%PHASE_PRES(imat, i)
112 lbuf%SIG(ii + 1 * nel) = -multi_fvm%PHASE_PRES(imat, i)
113 lbuf%SIG(ii + 2 * nel) = -multi_fvm%PHASE_PRES(imat, i)
114 ENDDO
115 ENDDO
116CCCCC
117 IF (multi_fvm%MUSCL > 0) THEN
118 DO ii = 1, nel
119 i = ii + nft
120 multi_fvm%RHO(i) = zero
121 ENDDO
122 DO imat = 1, nbmat
123 DO ii = 1, nel
124 i = ii + nft
125 multi_fvm%RHO(i) = multi_fvm%RHO(i) +
126 . multi_fvm%PHASE_ALPHA(imat, i) * multi_fvm%PHASE_RHO(imat, i)
127 ENDDO
128 ENDDO
129 ENDIF
130 ENDIF
131 ENDIF !IF (MATLAW == 151) THEN
132 ENDDO ! NG
#define my_real
Definition cppsort.cpp:32