OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ale_euler_init.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!|| ale_euler_init ../starter/source/materials/ale/ale_euler_init.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_part ../starter/source/model/assembling/hm_read_part.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| loi_fluid ../starter/source/fluid/loi_fluid.F
31!|| nintri ../starter/source/system/nintrr.F
32!||--- uses -----------------------------------------------------
33!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
34!|| message_mod ../starter/share/message_module/message_mod.F
35!||====================================================================
36 SUBROUTINE ale_euler_init(MLAW_TAG,IPM,PM, IGEO,TITR,TITR1,TITR2,IGTYP,ID,ILAW,
37 . MID,IMID,PID,IPID,JALE_FROM_PROP,JALE_FROM_MAT,ITHERM,ITHERM_FE)
38C-----------------------------------------------
39C D e s c r i p t i o n
40C-----------------------------------------------
41C This subroutine is setting global parameter for ALE/EULER framework
42C %L_SSP : buffer size to allocate sound speed in element buffer
43C ALE%UPWIND%UPWMG : global parameter for 'M'omentum convection : upwind
44C ALE%UPWIND%UPWOG : global parameter for 'O'ther convections (energy, mass) : upwind
45C IALE,IEULER,ILAG : global flag to detect if ALE, EULER, or none of them was defined in the input file
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE message_mod
50 USE elbuftag_mod
51 USE alefvm_mod , only:alefvm_param
52 USE ale_mod
53 USE names_and_titles_mod , ONLY : nchartitle
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "scr06_c.inc"
62#include "scr17_c.inc"
63#include "com01_c.inc"
64#include "com04_c.inc"
65#include "param_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 TYPE(mlaw_tag_), DIMENSION(NUMMAT), INTENT(INOUT) :: MLAW_TAG
70 CHARACTER(LEN=NCHARTITLE), INTENT(INOUT) :: TITR,TITR1,TITR2
71 INTEGER,INTENT(INOUT):: ITHERM
72 INTEGER,INTENT(INOUT):: ITHERM_FE
73 INTEGER,INTENT(INOUT)::IGEO(NPROPGI,NUMGEO)
74 INTEGER,INTENT(IN) :: ID,IMID,PID,IPID,IGTYP,ILAW
75 INTEGER,INTENT(INOUT) :: MID,JALE_FROM_PROP,JALE_FROM_MAT
76 INTEGER, DIMENSION(NPROPMI,NUMMAT), INTENT(INOUT) :: IPM
77 my_real, DIMENSION(NPROPM,NUMMAT), INTENT(INOUT) :: pm
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER II,uID1,uID2,MID1,MID2,ILAW1,ILAW2,JALE,JTUR,IMAT,MAT_ID,IGFLU
82 INTEGER JTHE,STAT,CODCONV,CODREZO,IEXPAN
83 INTEGER,EXTERNAL :: NINTRI
84 CHARACTER*5 CHAR_PROP,CHAR_MAT
85C-----------------------------------------------
86C E x t e r n a l F u n c t i o n s
87C-----------------------------------------------
88 LOGICAL,EXTERNAL :: LOI_FLUID
89C-----------------------------------------------
90C S o u r c e L i n e s
91C-----------------------------------------------
92
93 !################################################################!
94 ! EULER & ALE : CHECK CONSISTENCY BETWEEN MAT and PROP !
95 !################################################################!
96 ! JALE_FROM_MAT = PM(72) 0:lagrange 1:ale 2:euler
97 ! JALE_FROM_PROP = IGEO(62) 0:lagrange 1:ale 2:euler
98
99 !/ALE/MAT or /EULER/MAT
100 jale_from_mat = 0
101 IF(imid > 0)THEN
102 jale_from_mat = pm(72,imid)
103 !character string for possible error message
104 IF(jale_from_mat == 1)THEN
105 char_mat = 'ALE '
106 ELSEIF(jale_from_mat == 2)THEN
107 char_mat = 'EULER'
108 ENDIF
109 ELSE
110 jale_from_mat = 0
111 ENDIF
112
113 !/PROP/SOLID
114 jale_from_prop = 0
115 !/PROP_TYPE14 (IALE_FLAG)
116 IF(ipid > 0)THEN
117 jale_from_prop = igeo(62,ipid)
118 !character string for possible error message
119 IF(jale_from_prop == 1)THEN
120 char_prop = 'ALE '
121 ELSEIF(jale_from_prop == 2)THEN
122 char_prop = 'EULER'
123 ENDIF
124 ELSE
125 jale_from_prop = 0
126 ENDIF
127
128 !display error message if MATERIAL and PROPERTY have inconsistent definitions
129 IF(jale_from_mat > 0 .AND. jale_from_prop > 0)THEN
130 IF(ilaw==77)THEN
131 !law77 is not compatible with ALE or EULER framework
132 CALL ancmsg(msgid=1120,msgtype=msgerror,anmode=aninfo_blind_1,i1=mid,c1=titr2 )
133 ELSE
134 IF(jale_from_mat /= jale_from_prop)THEN
135 CALL ancmsg(msgid=130,msgtype=msgerror,anmode=aninfo_blind_1,
136 . i1=id, c1=titr,
137 . i2=pid,c2=titr1,c3=char_prop,
138 . i3=mid,c4=titr2,c5=char_mat )
139 ENDIF
140 ENDIF
141 ENDIF
142
143 !################################################################! !(14)'SOLID'
144 ! EULERIAN AND ALE CASES : ALLOWS ONLY IGTYP=14 & IGTYP=15 ! !(14)'FLUID'
145 !################################################################! !(15)'POROUS'
146 IF(jale_from_mat > 0 .OR. jale_from_prop > 0)THEN
147 IF (ilaw == 151 .AND. n2d /= 0) THEN
148 !Allow tria for 2D law 151
149 IF(igtyp/=14.AND.igtyp/=15.AND.igtyp/=1)THEN
150 CALL ancmsg(msgid=42,
151 . msgtype=msgerror,
152 . anmode=aninfo,
153 . i1=id)
154 mid=0
155 pm(1:npropm,imid) = zero
156 ipm(1:npropmi,imid) = 0
157 ENDIF
158 ELSE
159 IF(igtyp/=14.AND.igtyp/=15)THEN
160 !material set to void for normal termination otherwise engine will set value to non allocated arrays.
161 CALL ancmsg(msgid=42,msgtype=msgerror,anmode=aninfo,i1=id)
162 !material set to void for normal termination otherwise engine will set value to non allocated arrays.
163 mid=0
164 pm(1:npropm,imid) = zero
165 ipm(1:npropmi,imid) = 0
166 ENDIF
167 ENDIF
168 ENDIF
169
170 !################################################################!
171 ! MULTIMATERIAL CANNOT BE DEFINED IN LAGRANGIAN FRAMEWORK !
172 !################################################################!
173 !display error message if MATERIAL 20,37,51,151 are set with lagrangian framework
174 IF(jale_from_mat == 0 .AND. jale_from_prop == 0)THEN
175 IF(ilaw==20 .OR. ilaw==37 .OR. ilaw==51 .OR. ilaw==151)THEN
176 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid),ltitr)
177 CALL fretitl2(titr2,ipm(npropmi-ltitr+1,imid),ltitr)
178 CALL ancmsg(msgid=101, msgtype=msgerror,anmode=aninfo,
179 . i1=id, c1=titr,
180 . i2=pid,c2=titr1,
181 . i3=mid,c3=titr2,
182 . i4=ilaw)
183 ENDIF
184 ENDIF
185
186 !################################################################!
187 ! /HEAT/MAT : thermal global flag ITHEM & ITHERM_FE !
188 !################################################################!
189 ! JALE_FROM_MAT = PM(72) 0:lagrange 1:ale 2:euler
190 ! JALE_FROM_PROP = IGEO(62) 0:lagrange 1:ale 2:euler
191 ! ITHERM : 1 => there are elements which require temperature at centroids
192 ! ITHERM_FE : 1 => there are elements which require for temperature at nodes
193 jthe = 0
194 IF(imid > 0) jthe = nint(pm(71,imid))
195 IF( jthe > 0 )THEN
196 IF(jale_from_prop>0 .OR. jale_from_mat>0)THEN
197 itherm = 1
198 ELSE
199 itherm_fe = 1
200 ENDIF
201 ENDIF
202
203 !################################################################!
204 ! /THERM/STRESS !
205 !################################################################!
206 iexpan=0
207 IF(imid > 0) iexpan=ipm(218,imid)
208 IF(iexpan > 0)THEN
209 IF(jale_from_prop>0 .OR. jale_from_mat>0)THEN
210 CALL ancmsg(msgid=1723,msgtype=msgerror,anmode=aninfo,i1=imat,c1=titr)
211 ENDIF
212 ENDIF
213
214 !################################################################!
215 ! SOUND SPEED BUFFER
216 !################################################################!
217 IF(jale_from_prop > 0 .OR. jale_from_mat > 0)THEN
218 IF(imid > 0)THEN
219 mlaw_tag(imid)%L_SSP = 1
220 IF(ilaw == 20)THEN
221 uid1 = nint(pm(21,imid))
222 uid2 = nint(pm(22,imid))
223 mid1 = nintri(uid1,ipm,npropmi,nummat,1)
224 mid2 = nintri(uid2,ipm,npropmi,nummat,1)
225 ilaw1 = ipm(2,mid1)
226 ilaw2 = ipm(2,mid2)
227 ilaw2 = ipm(2,mid2)
228 pm(15,mid1) = ale%UPWIND%UPWMG
229 pm(15,mid2) = ale%UPWIND%UPWMG
230 pm(16,mid1) = ale%UPWIND%UPWOG
231 pm(16,mid2) = ale%UPWIND%UPWOG
232 mlaw_tag(mid1)%L_SSP = 1 ! boundary layer material (ilaw updated later in sgrtail.F)
233 mlaw_tag(mid2)%L_SSP = 1 ! boundary layer material (ilaw updated later in sgrtail.F)
234 ENDIF !ILAW==20
235 endif! IMID > 0
236 ENDIF
237
238 !################################################################!
239 ! specific treatment law11(boundary material)
240 !################################################################!
241 IF(jale_from_prop > 0)THEN
242 IF(ilaw == 11)THEN
243 IF(pm(92,imid) == zero)THEN
244 pm(92,imid) = one
245 ENDIF
246 ENDIF
247 ENDIF
248
249 !################################################################!
250 ! GLOBAL FLAGS
251 !################################################################!
252 IF ((jale_from_prop == 0 .AND. jale_from_mat == 0).AND. ilaw/=18 .AND. ilaw/=11) THEN
253 ilag=1
254 ELSEIF(jale_from_prop == 1 .OR. jale_from_mat == 1)THEN
255 iale=1
256 ELSEIF(jale_from_prop == 2 .OR. jale_from_mat == 2)THEN
257 ieuler=1
258 ELSE
259 ilag=1
260 ENDIF
261
262 !################################################################!
263 ! UPWIND (backward compatibility)
264 !################################################################!
265 IF (jale_from_prop /= 0 .OR. jale_from_mat /= 0) THEN
266 pm(15,imid) = ale%UPWIND%UPWMG
267 pm(16,imid) = ale%UPWIND%UPWOG
268 ENDIF
269
270 !################################################################!
271 ! TURBULENCY
272 !################################################################!
273 jtur=0
274 IF(imid > 0) jtur = nint(pm(70,imid))
275 IF (ilaw /= 50) iturb = max(iturb ,jtur)
276
277 !################################################################!
278 ! CONVERTION-REZONING CODES/FLAGS (Reynolds transport theorem)
279 !################################################################!-
280 codconv=0 !convection : local flags related to current material law (CODV are global values)
281 codrezo=0 !rezoning : local flags
282
283 !default convection
284 IF(jale_from_prop /= 0 .OR. jale_from_mat /= 0)THEN
285 IF(ilaw==1 .OR.
286 . ilaw==2 .OR.
287 . ilaw==3 .OR.
288 . ilaw==4 .OR.
289 . ilaw==5 .OR.
290 . ilaw==6 .OR.
291 . ilaw==7 .OR.
292 . ilaw==8 .OR.
293 . ilaw==9 .OR.
294 . ilaw==10 .OR.
295 . ilaw==11 .OR.
296 . ilaw==13 .OR.
297 . ilaw==16 .OR.
298 . ilaw==17 .OR.
299 . ilaw==18 .OR.
300 . ilaw==20 .OR.
301 . ilaw==21 .OR.
302 . ilaw==22 .OR.
303 . ilaw==23 .OR.
304 . ilaw==26 .OR.
305 . ilaw==29 .OR.
306 . ilaw==30 .OR.
307 . ilaw==31 .OR.
308 . ilaw==36 .OR.
309 . ilaw==37 .OR.
310 . ilaw==41 .OR.
311 . ilaw==44 .OR.
312 . ilaw==46 .OR.
313 . ilaw==47 .OR.
314 . ilaw==49 .OR.
315 . ilaw>=50 )THEN
316 !local flags
317 codconv = codconv + 11
318 !global flags
319 ale%GLOBAL%CODV(1) = 01
320 ale%GLOBAL%CODV(2) = 01
321 ENDIF
322 ENDIF
323
324 !turbulency
325 IF(jtur > 0) THEN
326 !local flags
327 codconv = codconv + 1100
328 !global flags
329 ale%GLOBAL%CODV(3)=1
330 ale%GLOBAL%CODV(4)=1
331 ENDIF
332
333 !specific convection (massic fraction, and lee-tarver parameter)
334 IF(ilaw == 37 .OR. ilaw == 41)THEN
335 !local flags
336 codconv = codconv + 10000
337 !global flags
338 ale%GLOBAL%CODV(5)=1
339 ENDIF
340
341 !default rezoning(remapping) for deviatoric stress
342 IF( (jale_from_prop /= 0 .OR. jale_from_mat /= 0) .AND. (
343 . ilaw == 2 .OR.
344 . ilaw == 3 .OR.
345 . ilaw == 4 .OR.
346 . ilaw == 7 .OR.
347 . ilaw == 8 .OR.
348 . ilaw == 9 .OR.
349 . ilaw == 10 .OR.
350 . ilaw == 16 .OR.
351 . ilaw == 21 .OR.
352 . ilaw == 22 .OR.
353 . ilaw == 23 .OR.
354 . ilaw == 26 .OR.
355 . ilaw == 28 .OR.
356 . ilaw == 29 .OR.
357 . ilaw == 30 .OR.
358 . ilaw == 31 .OR.
359 . ilaw == 36 .OR.
360 . ilaw == 44 .OR.
361 . ilaw == 49 .OR.
362 . ilaw == 97 ) )THEN
363 codrezo=11
364 ENDIF
365
366 IF( (jale_from_prop /= 0 .OR. jale_from_mat /= 0) .AND. ilaw == 1)THEN
367 codrezo=1
368 ENDIF
369
370 !---ALEFVM (obsolete)---!
371 IF( (jale_from_prop /= 0 .OR. jale_from_mat /= 0) .AND. alefvm_param%IEnabled == 1)THEN
372 !Momentum Convection : %MOM(1:3,:)
373 !local flags
374 codconv = codconv + 11100000
375 !global flags
376 ale%GLOBAL%CODV(6) = 1
377 ale%GLOBAL%CODV(7) = 1
378 ale%GLOBAL%CODV(8) = 1
379 ENDIF
380
381 !storing values in material buffer for backward compatibility
382 pm(10,imid)=codconv+em01
383 pm(11,imid)=codrezo+em01
384
385 !################################################################!
386 ! CFD CONSISTENCY (OBSOLETE OPTION /CAA) !
387 !################################################################!
388 igflu=0
389 IF(ipid > 0)igflu=igeo(36,ipid)
390 !### CAA without fluid material (CAA is obsolete)
391 IF(ale%GLOBAL%ICAA /= 0)THEN
392 IF( jale_from_prop==1 .OR. jale_from_prop==2
393 . .OR. jale_from_mat==1 .OR. jale_from_mat==2 )THEN !ALE or EULER
394 IF(.NOT.loi_fluid(ilaw)) THEN
395 CALL ancmsg(msgid=37,msgtype=msgwarning,anmode=aninfo_blind_1,
396 . i1=id ,c1=titr ,
397 . i2=mid ,c2=titr2,
398 . i3=ilaw)
399 ENDIF
400 ENDIF
401 ENDIF
402 !### /PROP/FLUID without FLUID material
403 IF( (igflu==1) .AND. .NOT.(loi_fluid(ilaw)) .AND. (ale%GLOBAL%ICAA == 0) .AND. (igtyp == 14) )THEN
404 CALL ancmsg(msgid=38,msgtype=msgerror,anmode=aninfo_blind_1,
405 . i1=id ,c1=titr ,
406 . i2=pid ,c2=titr1,
407 . i3=mid ,c3=titr2,
408 . i4=ilaw )
409 ENDIF
410 !-------------------------------------
411
412
413 !################################################################!
414 ! CFD CONSISTENCY (OBSOLETE OPTION /CAA) !
415 !################################################################!
416 igflu=0
417 IF(ipid > 0)igflu=igeo(36,ipid)
418 !### CAA without fluid material (CAA is obsolete)
419 IF(ale%GLOBAL%ICAA /= 0)THEN
420 IF( jale_from_prop==1 .OR. jale_from_prop==2
421 . .OR. jale_from_mat==1 .OR. jale_from_mat==2 )THEN !ALE or EULER
422 IF(.NOT.loi_fluid(ilaw)) THEN
423 CALL ancmsg(msgid=37,msgtype=msgwarning,anmode=aninfo_blind_1,
424 . i1=id ,c1=titr ,
425 . i2=mid ,c2=titr2,
426 . i3=ilaw)
427 ENDIF
428 ENDIF
429 ENDIF
430 !### /PROP/FLUID without FLUID material
431 IF( (igflu==1) .AND. .NOT.(loi_fluid(ilaw)) .AND. (ale%GLOBAL%ICAA == 0) .AND. (igtyp == 14) )THEN
432 CALL ancmsg(msgid=38,msgtype=msgerror,anmode=aninfo_blind_1,
433 . i1=id ,c1=titr ,
434 . i2=pid ,c2=titr1,
435 . i3=mid ,c3=titr2,
436 . i4=ilaw )
437 ENDIF
438 !-------------------------------------
439
440
441 RETURN
442 END SUBROUTINE ale_euler_init
ale_euler_init
subroutine ale_euler_init(mlaw_tag, ipm, pm, igeo, titr, titr1, titr2, igtyp, id, ilaw, mid, imid, pid, ipid, jale_from_prop, jale_from_mat, itherm, itherm_fe)
Definition ale_euler_init.F:38
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121
elbuftag_mod
Definition elbuftag_mod.F:227
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
elbuftag_mod::mlaw_tag_
Definition elbuftag_mod.F:232