OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
multi_allocate.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "spmd_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine multi_allocate (multi_fvm, h3d_data)

Function/Subroutine Documentation

◆ multi_allocate()

subroutine multi_allocate ( type(multi_fvm_struct) multi_fvm,
type (h3d_database) h3d_data )

Definition at line 35 of file multi_allocate.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE multi_fvm_mod
40 USE message_mod
41 USE h3d_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49!NSPMD
50#include "com01_c.inc"
51#include "com04_c.inc"
52#include "spmd_c.inc"
53C----------------------------------------------
54C D u m m y a r g u m e n t s
55C----------------------------------------------
56 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
57 TYPE (H3D_DATABASE) :: H3D_DATA
58C----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER :: IERR, LEN, NBMAT
62C----------------------------------------------
63C B e g i n n i n g o f s u b r o u t i n e
64C----------------------------------------------
65C Multifluid law
66 IF (multi_fvm%IS_USED) THEN
67C Number of submaterials
68 nbmat = multi_fvm%NBMAT
69 IF (n2d == 0) THEN
70 len = numels + nsvois
71 ELSE
72 len = numelq + nqvois + numeltg + ntgvois
73 ENDIF
74 multi_fvm%NELEM = len
75C Face datas
76 ALLOCATE(multi_fvm%FACE_DATA%SURF(6, len), stat = ierr)
77 IF (ierr /= 0) THEN
78 CALL ancmsg(msgid=20,anmode=aninfo)
79 CALL arret(2)
80 ENDIF
81 ALLOCATE(multi_fvm%FACE_DATA%NORMAL(3, 6, len), stat = ierr)
82 IF (ierr /= 0) THEN
83 CALL ancmsg(msgid=20,anmode=aninfo)
84 CALL arret(2)
85 ENDIF
86 ALLOCATE(multi_fvm%FACE_DATA%WFAC(3, 6, len), stat = ierr)
87 IF (ierr /= 0) THEN
88 CALL ancmsg(msgid=20,anmode=aninfo)
89 CALL arret(2)
90 ENDIF
91C fluxes
92 ALLOCATE(multi_fvm%FLUXES(6, 6, len), stat = ierr)
93 IF (ierr /= 0) THEN
94 CALL ancmsg(msgid=20,anmode=aninfo)
95 CALL arret(2)
96 ENDIF
97C submaterial fluxes
98C Volume fluxes
99 IF (nbmat > 1) THEN
100 ALLOCATE(multi_fvm%SUBVOL_FLUXES(nbmat, 6, len), stat = ierr)
101 IF (ierr /= 0) THEN
102 CALL ancmsg(msgid=20,anmode=aninfo)
103 CALL arret(2)
104 ENDIF
105 ALLOCATE(multi_fvm%SUBMASS_FLUXES(nbmat, 6, len), stat = ierr)
106 IF (ierr /= 0) THEN
107 CALL ancmsg(msgid=20,anmode=aninfo)
108 CALL arret(2)
109 ENDIF
110 ALLOCATE(multi_fvm%SUBENER_FLUXES(nbmat, 6, len), stat = ierr)
111 IF (ierr /= 0) THEN
112 CALL ancmsg(msgid=20,anmode=aninfo)
113 CALL arret(2)
114 ENDIF
115
116 ALLOCATE(multi_fvm%PHASE_ALPHA(nbmat, len), stat = ierr)
117 IF (ierr /= 0) THEN
118 CALL ancmsg(msgid=20,anmode=aninfo)
119 CALL arret(2)
120 ENDIF
121 ALLOCATE(multi_fvm%PHASE_PRES(nbmat, len), stat = ierr)
122 IF (ierr /= 0) THEN
123 CALL ancmsg(msgid=20,anmode=aninfo)
124 CALL arret(2)
125 ENDIF
126 ALLOCATE(multi_fvm%PHASE_RHO(nbmat, len), stat = ierr)
127 IF (ierr /= 0) THEN
128 CALL ancmsg(msgid=20,anmode=aninfo)
129 CALL arret(2)
130 ENDIF
131 ALLOCATE(multi_fvm%PHASE_EINT(nbmat, len), stat = ierr)
132 IF (ierr /= 0) THEN
133 CALL ancmsg(msgid=20,anmode=aninfo)
134 CALL arret(2)
135 ENDIF
136 ENDIF
137C Allocation of centroid velocities
138 ALLOCATE(multi_fvm%VEL(3, len), stat = ierr)
139 IF (ierr /= 0) THEN
140 CALL ancmsg(msgid=20,anmode=aninfo)
141 CALL arret(2)
142 ENDIF
143 multi_fvm%VEL(:, :) = zero
144C Allocation of centroid accelerations
145 IF(h3d_data%N_VECT_ACC == 1)THEN
146 ALLOCATE(multi_fvm%ACC(3, len), stat = ierr)
147 IF (ierr /= 0) THEN
148 CALL ancmsg(msgid=20,anmode=aninfo)
149 CALL arret(2)
150 ENDIF
151 multi_fvm%ACC(:, :) = zero
152 ENDIF
153C Allocation of soud speed
154 ALLOCATE(multi_fvm%SOUND_SPEED(len), stat = ierr)
155 IF (ierr /= 0) THEN
156 CALL ancmsg(msgid=20,anmode=aninfo)
157 CALL arret(2)
158 ENDIF
159 multi_fvm%SOUND_SPEED(:) = zero
160C Allocation of TBURN
161 ALLOCATE(multi_fvm%TBURN(len), stat = ierr)
162 IF (ierr /= 0) THEN
163 CALL ancmsg(msgid=20,anmode=aninfo)
164 CALL arret(2)
165 ENDIF
166 multi_fvm%TBURN(:) = zero
167C Allocation of BFRAC
168 ALLOCATE(multi_fvm%BFRAC(nbmat, len), stat = ierr)
169 IF (ierr /= 0) THEN
170 CALL ancmsg(msgid=20,anmode=aninfo)
171 CALL arret(2)
172 ENDIF
173 multi_fvm%BFRAC(:, :) = zero
174C Allocation of temporary var 1
175 ALLOCATE(multi_fvm%RHO(len), stat = ierr)
176 IF (ierr /= 0) THEN
177 CALL ancmsg(msgid=20,anmode=aninfo)
178 CALL arret(2)
179 ENDIF
180 multi_fvm%RHO(:) = zero
181C Allocation of temporary var 2
182 ALLOCATE(multi_fvm%EINT(len), stat = ierr)
183 IF (ierr /= 0) THEN
184 CALL ancmsg(msgid=20,anmode=aninfo)
185 CALL arret(2)
186 ENDIF
187 multi_fvm%EINT(:) = zero
188C Allocation of temporary var 3
189 ALLOCATE(multi_fvm%PRES(len), stat = ierr)
190 IF (ierr /= 0) THEN
191 CALL ancmsg(msgid=20,anmode=aninfo)
192 CALL arret(2)
193 ENDIF
194 multi_fvm%PRES(:) = zero
195C MUSCL Variables
196 IF (multi_fvm%MUSCL == 1) THEN
197 ALLOCATE(multi_fvm%GRAD_RHO(3, len), stat = ierr)
198 IF (ierr /= 0) THEN
199 CALL ancmsg(msgid=20,anmode=aninfo)
200 CALL arret(2)
201 ENDIF
202 ALLOCATE(multi_fvm%GRAD_U(3, len), stat = ierr)
203 IF (ierr /= 0) THEN
204 CALL ancmsg(msgid=20,anmode=aninfo)
205 CALL arret(2)
206 ENDIF
207 ALLOCATE(multi_fvm%GRAD_V(3, len), stat = ierr)
208 IF (ierr /= 0) THEN
209 CALL ancmsg(msgid=20,anmode=aninfo)
210 CALL arret(2)
211 ENDIF
212 ALLOCATE(multi_fvm%GRAD_W(3, len), stat = ierr)
213 IF (ierr /= 0) THEN
214 CALL ancmsg(msgid=20,anmode=aninfo)
215 CALL arret(2)
216 ENDIF
217 ALLOCATE(multi_fvm%GRAD_PRES(3, len), stat = ierr)
218 IF (ierr /= 0) THEN
219 CALL ancmsg(msgid=20,anmode=aninfo)
220 CALL arret(2)
221 ENDIF
222 IF (nbmat > 1) THEN
223 ALLOCATE(multi_fvm%PHASE_GRAD_RHO(3, nbmat, len), stat = ierr)
224 IF (ierr /= 0) THEN
225 CALL ancmsg(msgid=20,anmode=aninfo)
226 CALL arret(2)
227 ENDIF
228 ALLOCATE(multi_fvm%PHASE_GRAD_ALPHA(3, nbmat, len), stat = ierr)
229 IF (ierr /= 0) THEN
230 CALL ancmsg(msgid=20,anmode=aninfo)
231 CALL arret(2)
232 ENDIF
233 ALLOCATE(multi_fvm%PHASE_GRAD_PRES(3, nbmat, len), stat = ierr)
234 IF (ierr /= 0) THEN
235 CALL ancmsg(msgid=20,anmode=aninfo)
236 CALL arret(2)
237 ENDIF
238 ENDIF
239 ENDIF
240
241 IF (multi_fvm%MUSCL == 2) THEN
242C Only volume fraction
243 IF (nbmat > 1) THEN
244 ALLOCATE(multi_fvm%PHASE_GRAD_ALPHA(3, nbmat, len), stat = ierr)
245 IF (ierr /= 0) THEN
246 CALL ancmsg(msgid=20,anmode=aninfo)
247 CALL arret(2)
248 ENDIF
249 ENDIF
250 ENDIF
251 IF (multi_fvm%MUSCL > 0) THEN
252 ALLOCATE(multi_fvm%FACE_DATA%CENTROID(3, 6, len), stat = ierr)
253 IF (ierr /= 0) THEN
254 CALL ancmsg(msgid=20,anmode=aninfo)
255 CALL arret(2)
256 ENDIF
257 ALLOCATE(multi_fvm%ELEM_DATA%CENTROID(3, len), stat = ierr)
258 IF (ierr /= 0) THEN
259 CALL ancmsg(msgid=20,anmode=aninfo)
260 CALL arret(2)
261 ENDIF
262 ENDIF
263 ENDIF
264C----------------------------------------------
265C E n d o f s u b r o u t i n e
266C----------------------------------------------
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87