OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_ebcs_inlet.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!|| hm_read_ebcs_inlet ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_inlet.F
25!||--- called by ------------------------------------------------------
26!|| read_ebcs ../starter/source/boundary_conditions/ebcs/read_ebcs.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
30!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
31!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
32!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
33!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
34!|| ngr2usr ../starter/source/system/nintrr.F
35!||--- uses -----------------------------------------------------
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_read_ebcs_inlet(IGRSURF,NPC, MULTI_FVM, UNITAB, ID, TITR, UID, LSUBMODEL, KEY2, SUB_INDEX, EBCS)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE unitab_mod
44 USE message_mod
45 USE multi_fvm_mod
46 USE groupdef_mod
47 USE submodel_mod
48 USE ebcs_mod
49 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "units_c.inc"
58#include "com04_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
63 INTEGER NPC(*)
64 INTEGER ID,UID
65 INTEGER,INTENT(IN) :: SUB_INDEX !< submodel index used to shift function identifiers if defined
66 TYPE (MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
67 TYPE (SURF_) ,TARGET, DIMENSION(NSURF) :: IGRSURF
68 CHARACTER(LEN=NCHARTITLE), INTENT(IN) :: TITR
69 TYPE(submodel_data) LSUBMODEL(NSUBMOD)
70 LOGICAL IS_AVAILABLE,IS_ENCRYPTED
71 CHARACTER(LEN=NCHARKEY),INTENT(IN) :: KEY2
72 TYPE(t_ebcs_inlet), INTENT(INOUT) :: EBCS
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER ISU,SURF,NGR2USR,IPRES,IRHO,J,NSEG,IENER,IVX,IVY,IVZ,IALPHA
77 INTEGER IMAT,IVEL_TYP,U_IALPHA,U_IRHO,U_IPRES,IFLAGUNIT,OFF_DEF
78 my_real :: check_cumul_vf(2)
79 my_real c,pres,rho,lcar,r1,r2,ener,vx,vy,vz, alpha
80 CHARACTER chain*9, chain1*64
81 EXTERNAL ngr2usr
82 LOGICAL FOUND
83 INTEGER, DIMENSION(:), POINTER :: INGR2USR
84C-----------------------------------------------
85C S o u r c e L i n e s
86C-----------------------------------------------
87
88 ebcs%title = trim(titr)
89
90 ebcs%IS_MULTIFLUID = .true.
91 ebcs%HAS_IELEM = .true.
92 ebcs%FVM_INLET_DATA%FORMULATION = -1
93 ebcs%FVM_INLET_DATA%VECTOR_VELOCITY = 0
94 ebcs%FVM_INLET_DATA%FUNC_VEL(1:3) = 0
95 ebcs%FVM_INLET_DATA%FUNC_ALPHA(1:21) = 0
96 ebcs%FVM_INLET_DATA%FUNC_RHO(1:21) = 0
97 ebcs%FVM_INLET_DATA%FUNC_PRES(1:21) = 0
98 ebcs%FVM_INLET_DATA%VAL_VEL(1:3) = zero
99 ebcs%FVM_INLET_DATA%VAL_ALPHA(1:21) = zero
100 ebcs%FVM_INLET_DATA%VAL_RHO(1:21) = zero
101 ebcs%FVM_INLET_DATA%VAL_PRES(1:21) = zero
102 ipres=0
103 ivx=0
104 ivy=0
105 ivz=0
106 irho=0
107 iener=0
108 c=zero
109 pres=zero
110 rho=zero
111 lcar=zero
112 r1=zero
113 r2=zero
114 ener=zero
115 vx=zero
116 vy=zero
117 vz=zero
118
119 iflagunit=0
120 DO j=1,unitab%NUNITS
121 IF (unitab%UNIT_ID(j) == uid) THEN
122 iflagunit = 1
123 EXIT
124 ENDIF
125 ENDDO
126 IF (uid/=0.AND.iflagunit==0) THEN
127 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,i2=uid,i1=id,c1='EBCS',c2='EBCS',c3=titr)
128 ENDIF
129
130 CALL hm_option_is_encrypted(is_encrypted)
131 CALL hm_get_intv('entityid', surf ,is_available,lsubmodel)
132 CALL hm_get_intv('vel_flag', ebcs%fvm_inlet_data%VECTOR_VELOCITY ,is_available,lsubmodel)
133
134 isu=0
135 ivel_typ = ebcs%fvm_inlet_data%VECTOR_VELOCITY
136 ingr2usr => igrsurf(1:nsurf)%ID
137 IF (surf/=0) isu=ngr2usr(surf,ingr2usr,nsurf)
138 nseg=0
139 IF (isu/=0) nseg=igrsurf(isu)%NSEG
140 IF(surf==0)THEN
141 ierr=ierr+1
142 WRITE(istdo,'(6X,A)')' ** A SURFACE SHOULD BE INPUT'
143 WRITE(iout, '(6X,A)')' ** A SURFACE SHOULD BE INPUT'
144 ELSEIF(isu==0)THEN
145 ierr=ierr+1
146 WRITE(istdo,*)' ** ERROR SURFACE NOT FOUND, ID=',surf
147 WRITE(iout,*) ' ** ERROR SURFACE NOT FOUND, ID=',surf
148 ELSEIF(nseg==0)THEN
149 ierr=ierr+1
150 WRITE(istdo,*)' ** ERROR EMPTY SURFACE',surf
151 WRITE(iout,*) ' ** ERROR EMPTY SURFACE',surf
152 ENDIF
153
154 WRITE(iout,1018)id,trim(titr)
155
156 IF (key2(1:2) == 'VP') THEN
157 ebcs%fvm_inlet_data%FORMULATION = 1
158 WRITE(iout,1021)
159 ELSEIF (key2(1:2) == 'VE') THEN
160 ebcs%fvm_inlet_data%FORMULATION = 2
161 WRITE(iout,1022)
162 ELSE
163 CALL ancmsg(msgid=1602,msgtype=msgerror,anmode=aninfo,
164 . i1 = id,
165 . c1 = trim(titr),
166 . c2 = "AN INPUT FORMULATION HAS TO BE PROVIDED : VE, OR VP")
167 ENDIF
168
169 CALL hm_get_floatv('rad_ebcs_fscale_vx', vx ,is_available,lsubmodel,unitab)
170 CALL hm_get_floatv('rad_ebcs_fscale_vy', vy ,is_available,lsubmodel,unitab)
171 CALL hm_get_floatv('rad_ebcs_fscale_vz', vz ,is_available,lsubmodel,unitab)
172 CALL hm_get_intv('fct_IDvx', ivx ,is_available,lsubmodel)
173 CALL hm_get_intv('fct_IDvy', ivy ,is_available,lsubmodel)
174 CALL hm_get_intv('fct_IDvz', ivz ,is_available,lsubmodel)
175 IF(sub_index /= 0 ) THEN
176 off_def = lsubmodel(sub_index)%OFF_DEF
177 !since IVX, IVY, and IVZ may be -1, these values are shifted only if they are defined Spositive
178 IF(ivx > 0) ivx = ivx + off_def
179 IF(ivy > 0) ivy = ivy + off_def
180 IF(ivz > 0) ivz = ivz + off_def
181 ENDIF
182
183 IF(ivel_typ==0)THEN
184 !NORMAL VELOCITY
185 IF(ivx>0)THEN
186 found = .false.
187 DO j=1,nfunct
188 IF(ivx==npc(j)) THEN
189 WRITE(iout,1133)ivx,vx
190 ivx=j
191 found = .true.
192 EXIT
193 ENDIF
194 ENDDO
195 ELSEIF(ivx==0)THEN
196 IF(vy/=zero.OR.vz/=zero)THEN
197 !check that user is defining VX ocrrectly
198 CALL ancmsg(msgid=1602,msgtype=msgerror,anmode=aninfo,
199 . i1 = id,
200 . c1 = trim(titr),
201 . c2 = "NORMAL VELOCITY MUST BE INPUT WITH COMPONENT-1 WHEN VEL_FLAG SET TO 0")
202 ENDIF
203 WRITE(iout,1134)vx
204 ELSEIF(ivx==-1)THEN
205 WRITE(iout,1135)ivx
206 ENDIF
207
208 IF(ivx<-1 .OR. (ivx>0.AND. .NOT.found))THEN
209 CALL ancmsg(msgid = 1602,msgtype= msgerror,anmode = aninfo,
210 . i1 = id,
211 . c1 = trim(titr),
212 . c2 = "INVALID FUNCTION ID FOR VELOCITY-X")
213 ENDIF
214
215 ELSE
216 !VELOCITY COMPONENTS
217 IF(ivx>0)THEN
218 found = .false.
219 DO j=1,nfunct
220 IF(ivx==npc(j)) THEN
221 WRITE(iout,1121)ivx,vx
222 ivx=j
223 found = .true.
224 EXIT
225 ENDIF
226 ENDDO
227 ELSEIF(ivx==0)THEN
228 WRITE(iout,1124)ivx
229 ELSEIF(ivx==-1)THEN
230 WRITE(iout,1127)ivx
231 ENDIF
232 IF(ivx<-1 .OR. (ivx>0.AND. .NOT.found))THEN
233 CALL ancmsg(msgid = 1602, msgtype= msgerror,anmode = aninfo,
234 . i1 = id,
235 . c1 = trim(titr),
236 . c2 = "INVALID FUNCTION ID FOR VELOCITY-X")
237 ENDIF
238 IF(ivy>0)THEN
239 found = .false.
240 DO j=1,nfunct
241 IF(ivy==npc(j)) THEN
242 WRITE(iout,1122)ivy,vy
243 ivy=j
244 found = .true.
245 EXIT
246 ENDIF
247 ENDDO
248 ELSEIF(ivy==0)THEN
249 WRITE(iout,1125)ivy
250 ELSEIF(ivy==-1)THEN
251 WRITE(iout,1128)ivy
252 ENDIF
253 IF(ivy<-1 .OR. (ivy>0.AND. .NOT.found))THEN
254 CALL ancmsg(msgid = 1602,msgtype= msgerror,anmode = aninfo,
255 . i1 = id,
256 . c1 = trim(titr),
257 . c2 = "INVALID FUNCTION ID FOR VELOCITY-Y")
258 ENDIF
259
260 IF(ivz>0)THEN
261 found = .false.
262 DO j=1,nfunct
263 IF(ivz==npc(j)) THEN
264 WRITE(iout,1123)ivz,vz
265 ivz=j
266 found = .true.
267 EXIT
268 ENDIF
269 ENDDO
270 ELSEIF(ivz==0)THEN
271 WRITE(iout,1126)ivz
272 ELSEIF(ivz==-1)THEN
273 WRITE(iout,1129)ivz
274 ENDIF
275
276 IF(ivz<-1 .OR. (ivz>0.AND. .NOT.found))THEN
277 CALL ancmsg(msgid = 1602,msgtype= msgerror,anmode = aninfo,
278 . i1 = id,
279 . c1 = trim(titr),
280 . c2 = "INVALID FUNCTION ID FOR VELOCITY-Z")
281 ENDIF
282
283 ENDIF
284
285 ebcs%fvm_inlet_data%FUNC_VEL(1) = ivx
286 ebcs%fvm_inlet_data%VAL_VEL(1) = vx
287 ebcs%fvm_inlet_data%FUNC_VEL(2) = ivy
288 ebcs%fvm_inlet_data%VAL_VEL(2) = vy
289 ebcs%fvm_inlet_data%FUNC_VEL(3) = ivz
290 ebcs%fvm_inlet_data%VAL_VEL(3) = vz
291 check_cumul_vf(1:2) = zero
292
293 DO imat = 1, multi_fvm%NBMAT
294 CALL hm_get_float_array_index('Fscalevf_n', alpha ,imat,is_available,lsubmodel,unitab)
295 CALL hm_get_float_array_index('Fscalerho_n',rho ,imat,is_available,lsubmodel,unitab)
296 CALL hm_get_float_array_index('Fscalep_e_n',pres ,imat,is_available,lsubmodel,unitab)
297 CALL hm_get_int_array_index('fct_IDvf_n', ialpha,imat,is_available,lsubmodel)
298 CALL hm_get_int_array_index('fct_IDrho_n', irho ,imat,is_available,lsubmodel)
299 CALL hm_get_int_array_index('fct_IDp_e_n', ipres ,imat,is_available,lsubmodel)
300 IF(sub_index /= 0 ) THEN
301 off_def = lsubmodel(sub_index)%OFF_DEF
302 IF(ialpha > 0) ialpha = ialpha + off_def
303 IF(irho > 0) irho = irho + off_def
304 IF(ipres > 0) ipres = ipres + off_def
305 ENDIF
306 check_cumul_vf(1)=check_cumul_vf(1)+abs(ialpha)
307 check_cumul_vf(2)=check_cumul_vf(2)+abs(alpha)
308 !user ids backup
309 u_ialpha=ialpha
310 u_irho =irho
311 u_ipres =ipres
312 !check and get internal function id
313 IF(ialpha>0)THEN
314 found = .false.
315 DO j=1,nfunct
316 IF(ialpha==npc(j)) THEN
317 ialpha=j
318 found=.true.
319 EXIT
320 ENDIF
321 ENDDO
322 IF(.NOT.found)THEN
323 chain='SUBMAT-00'
324 write(chain(8:9),'(i2)')imat
325 chain1='INVALID FUNCTION ID FOR IALPHA & '//chain
326 CALL ancmsg(msgid = 1602,msgtype= msgerror,anmode = aninfo,
327 . i1 = id,
328 . c1 = trim(titr),
329 . c2 = chain1)
330 ENDIF
331 ENDIF
332 !check and get internal function id
333 IF(irho>0)THEN
334 found = .false.
335 DO j=1,nfunct
336 IF(irho==npc(j)) THEN
337 irho=j
338 found=.true.
339 EXIT
340 ENDIF
341 ENDDO
342 IF(.NOT.found)THEN
343 chain='SUBMAT-00'
344 write(chain(8:9),'(i2)')imat
345 chain1='INVALID FUNCTION ID FOR IRHO & '//chain
346 CALL ancmsg(msgid = 1602,msgtype= msgerror,anmode = aninfo,
347 . i1 = id,
348 . c1 = trim(titr),
349 . c2 = chain1)
350 ENDIF
351 ENDIF
352 !check and get internal function id
353 IF(ipres>0)THEN
354 found = .false.
355 DO j=1,nfunct
356 IF(ipres==npc(j)) THEN
357 ipres=j
358 found=.true.
359 EXIT
360 ENDIF
361 ENDDO
362 IF(.NOT.found)THEN
363 chain='SUBMAT-00'
364 write(chain(8:9),'(i2)')imat
365 chain1='INVALID FUNCTION ID FOR IPRES & '//chain
366 CALL ancmsg(msgid = 1602,msgtype= msgerror,anmode = aninfo,
367 . i1 = id,
368 . c1 = trim(titr),
369 . c2 = chain1)
370 ENDIF
371 ENDIF
372 IF(alpha<zero)THEN
373 CALL ancmsg(msgid = 1602,msgtype= msgerror,anmode = aninfo,
374 . i1 = id,
375 . c1 = trim(titr),
376 . c2 = "VOLUME FRACTION CANNOT BE NEGATIVE")
377 ENDIF
378 IF(rho<zero)THEN
379 CALL ancmsg(msgid = 1602,msgtype= msgerror,anmode = aninfo,
380 . i1 = id,
381 . c1 = trim(titr),
382 . c2 = "MASS DENSITY CANNOT BE NEGATIVE")
383 ENDIF
384 ebcs%fvm_inlet_data%FUNC_ALPHA(imat) = ialpha
385 ebcs%fvm_inlet_data%FUNC_RHO(imat) = irho
386 ebcs%fvm_inlet_data%FUNC_PRES(imat) = ipres
387 ebcs%fvm_inlet_data%VAL_ALPHA(imat) = alpha
388 ebcs%fvm_inlet_data%VAL_RHO(imat) = rho
389 ebcs%fvm_inlet_data%VAL_PRES(imat) = pres
390 WRITE(iout,1130)imat
391 WRITE(iout,1131)u_ialpha,u_irho,u_ipres
392 WRITE(iout,1132)alpha,rho,pres
393 ENDDO
394 WRITE(iout, fmt='(/)' )
395 IF(check_cumul_vf(1)==zero .AND. check_cumul_vf(2)==zero)THEN
396 CALL ancmsg(msgid = 1602,msgtype= msgerror,anmode = aninfo,
397 . i1 = id,
398 . c1 = trim(titr),
399 . c2 = "INPUT VOLUME FRACTIONS ARE EMPTY")
400 ENDIF
401
402
403 WRITE(iout,1118)surf,nseg
404
405 IF (.NOT. multi_fvm%IS_USED) THEN
406 CALL ancmsg(msgid=1602,msgtype=msgerror,anmode=aninfo,i1 = id,c1 = trim(titr),
407 . c2 = "ONLY COMPATIBLE WITH LAW 151")
408 ENDIF
409
410C-----------
411 RETURN
412C-----------
413 1018 FORMAT( //'FLUID INLET EBCS NUMBER . . . . . . . . :',i8,1x,a)
414 1021 FORMAT( ' VELOCITY & PRESSURE')
415 1022 FORMAT( ' VELOCITY & ENERGY')
416 1118 FORMAT(
417 . ' ON SURFACE . . . . . . . . . . . . . . . ',i8,/,
418 . ' NUMBER OF SEGMENTS FOUND. . . . . . . . . ',i8,/)
419 1121 FORMAT(
420 . ' IVx FUNCTION ID . . . . . . . . . . . . . ',i8,/,
421 . ' Vx SCALE FACTOR . . . . . . . . . . . . . ',e16.6)
422 1122 FORMAT(
423 . ' IVy FUNCTION ID . . . . . . . . . . . . . ',i8,/,
424 . ' vy scale factor . . . . . . . . . . . . . ',E16.6)
425 1123 FORMAT(
426 . ' ivz FUNCTION id . . . . . . . . . . . . . ',I8,/,
427 . ' vz scale factor . . . . . . . . . . . . . ',E16.6)
428 1124 FORMAT(
429 . ' ivx function id . . . . . . . . . . . . . ',I2)
430 1125 FORMAT(
431 . ' ivy function id . . . . . . . . . . . . . ',I2)
432 1126 FORMAT(
433 . ' ivz function id . . . . . . . . . . . . . ',I2)
434 1127 FORMAT(
435 . ' ivx function id . . . . . . . . . . . . . ',I2,/,
436 . ' von neumann bcs : d/dn(Vx) = 0')
437 1128 FORMAT(
438 . ' ivy function id . . . . . . . . . . . . . ',I2,/,
439 . ' von neumann bcs : d/dn(Vy) = 0')
440 1129 FORMAT(
441 . ' ivz function id . . . . . . . . . . . . . ',I2,/,
442 . ' von neumann bcs : d/dn(Vz) = 0')
443
444 1130 FORMAT(
445 . /,' submat-',I2)
446 1131 FORMAT(
447 . ' ialpha function. . . . . . . . . . . . .',I8,/,
448 . ' irho function. . . . . . . . . . . . . .',I8,/,
449 . ' ipres function. . . . . . . . . . . . . ',I8)
450 1132 FORMAT(
451 . ' alpha scale factor . . . . . . . . . . .',E16.6,/,
452 . ' rho scale factor . . . . . . . . . . . .',E16.6,/,
453 . ' pres scale function . . . . . . . . . . ',E16.6)
454 1133 FORMAT(
455 . ' ivn function id . . . . . . . . . . . . . ',I8,/,
456 . ' vn scale factor . . . . . . . . . . . . . ',E16.6)
457 1134 FORMAT(
458 . ' vn constant velocity. . . . . . . . . . . ',E16.6)
459 1135 FORMAT(
460 . ' ivn function id . . . . . . . . . . . . . ',I2,/,
461 . ' von neumann bcs : d/dn vn = 0')
462
463 END
464
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_read_ebcs_inlet
subroutine hm_read_ebcs_inlet(igrsurf, npc, multi_fvm, unitab, id, titr, uid, lsubmodel, key2, sub_index, ebcs)
Definition hm_read_ebcs_inlet.F:40
groupdef_mod
Definition groupdef_mod.F:662
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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
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
submodel_mod::submodel_data
Definition submodel_mod.F:723