OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_ebcs_inlet.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_ebcs_inlet (igrsurf, npc, multi_fvm, unitab, id, titr, uid, lsubmodel, key2, sub_index, ebcs)

Function/Subroutine Documentation

◆ hm_read_ebcs_inlet()

subroutine hm_read_ebcs_inlet ( type (surf_), dimension(nsurf), target igrsurf,
integer, dimension(*) npc,
type (multi_fvm_struct), intent(inout) multi_fvm,
type (unit_type_), intent(in) unitab,
integer id,
character(len=nchartitle), intent(in) titr,
integer uid,
type(submodel_data), dimension(nsubmod) lsubmodel,
character(len=ncharkey), intent(in) key2,
integer, intent(in) sub_index,
type(t_ebcs_inlet), intent(inout) ebcs )
Parameters
[in]sub_indexsubmodel index used to shift function identifiers if defined

Definition at line 39 of file hm_read_ebcs_inlet.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE unitab_mod
44 USE message_mod
45 USE groupdef_mod
46 USE submodel_mod
47 USE ebcs_mod
48 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
49 USE multi_fvm_mod , ONLY : multi_fvm_struct
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 (SURF_) ,TARGET, DIMENSION(NSURF) :: IGRSURF
67 CHARACTER(LEN=NCHARTITLE), INTENT(IN) :: TITR
68 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
69 LOGICAL IS_AVAILABLE,IS_ENCRYPTED
70 CHARACTER(LEN=NCHARKEY),INTENT(IN) :: KEY2
71 TYPE(t_ebcs_inlet), INTENT(INOUT) :: EBCS
72 TYPE (MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER :: ISU,SURF,IPRES,IRHO,J,NSEG,IENER,IVX,IVY,IVZ,IALPHA
77 INTEGER :: IMAT,IVEL_TYP,U_IALPHA,U_IRHO,U_IPRES,IFLAGUNIT,OFF_DEF
78 INTEGER :: NBMAT
79 my_real :: check_cumul_vf(2)
80 my_real :: c,pres,rho,lcar,r1,r2,ener,vx,vy,vz, alpha
81 CHARACTER :: chain*9, chain1*64
82 INTEGER, EXTERNAL :: NGR2USR
83 LOGICAL :: FOUND
84 INTEGER, DIMENSION(:), POINTER :: INGR2USR
85C-----------------------------------------------
86C S o u r c e L i n e s
87C-----------------------------------------------
88 ebcs%title = trim(titr)
89 ebcs%IS_MULTIFLUID = .false.
90 IF(multi_fvm%IS_USED)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 ! VELOCITY - PRESSURE : input rho-V-P
157 IF (key2(1:2) == 'VP') THEN
158 ebcs%fvm_inlet_data%FORMULATION = 1
159 WRITE(iout,1021)
160 ! VELOCITY - ENERGY : input rho-V-E
161 ELSEIF (key2(1:2) == 'VE') THEN
162 ebcs%fvm_inlet_data%FORMULATION = 2
163 WRITE(iout,1022)
164 ELSE
165 CALL ancmsg(msgid=1602, msgtype=msgerror, anmode=aninfo, i1=id, 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,i1=id,c1=trim(titr),
199 . c2="NORMAL VELOCITY MUST BE INPUT WITH COMPONENT-1 WHEN VEL_FLAG SET TO 0")
200 ENDIF
201 WRITE(iout,1134)vx
202 ELSEIF(ivx == -1)THEN
203 WRITE(iout,1135)ivx
204 ENDIF
205
206 IF(ivx < -1 .OR. (ivx > 0 .AND. .NOT.found))THEN
207 CALL ancmsg(msgid=1602, msgtype=msgerror, anmode=aninfo, i1=id, c1=trim(titr), c2="INVALID FUNCTION ID FOR VELOCITY-X")
208 ENDIF
209
210 ELSE
211 !VELOCITY COMPONENTS
212 IF(ivx > 0)THEN
213 found = .false.
214 DO j=1,nfunct
215 IF(ivx == npc(j)) THEN
216 WRITE(iout,1121)ivx,vx
217 ivx=j
218 found = .true.
219 EXIT
220 ENDIF
221 ENDDO
222 ELSEIF(ivx == 0)THEN
223 WRITE(iout,1124)ivx
224 ELSEIF(ivx == -1)THEN
225 WRITE(iout,1127)ivx
226 ENDIF
227 IF(ivx < -1 .OR. (ivx > 0 .AND. .NOT.found))THEN
228 CALL ancmsg(msgid=1602, msgtype=msgerror, anmode=aninfo, i1=id, c1=trim(titr),
229 . c2="INVALID FUNCTION ID FOR VELOCITY-X")
230 ENDIF
231 IF(ivy > 0)THEN
232 found = .false.
233 DO j=1,nfunct
234 IF(ivy == npc(j)) THEN
235 WRITE(iout,1122)ivy,vy
236 ivy=j
237 found = .true.
238 EXIT
239 ENDIF
240 ENDDO
241 ELSEIF(ivy == 0)THEN
242 WRITE(iout,1125)ivy
243 ELSEIF(ivy == -1)THEN
244 WRITE(iout,1128)ivy
245 ENDIF
246 IF(ivy < -1 .OR. (ivy > 0 .AND. .NOT.found))THEN
247 CALL ancmsg(msgid=1602, msgtype=msgerror, anmode=aninfo, i1=id, c1=trim(titr), c2="INVALID FUNCTION ID FOR VELOCITY-Y")
248 ENDIF
249
250 IF(ivz > 0)THEN
251 found = .false.
252 DO j=1,nfunct
253 IF(ivz == npc(j)) THEN
254 WRITE(iout,1123)ivz,vz
255 ivz=j
256 found = .true.
257 EXIT
258 ENDIF
259 ENDDO
260 ELSEIF(ivz == 0)THEN
261 WRITE(iout,1126)ivz
262 ELSEIF(ivz == -1)THEN
263 WRITE(iout,1129)ivz
264 ENDIF
265
266 IF(ivz < -1 .OR. (ivz > 0 .AND. .NOT.found))THEN
267 CALL ancmsg(msgid=1602, msgtype=msgerror, anmode=aninfo, i1=id, c1=trim(titr), c2="INVALID FUNCTION ID FOR VELOCITY-Z")
268 ENDIF
269
270 ENDIF
271
272 ebcs%fvm_inlet_data%FUNC_VEL(1) = ivx
273 ebcs%fvm_inlet_data%VAL_VEL(1) = vx
274 ebcs%fvm_inlet_data%FUNC_VEL(2) = ivy
275 ebcs%fvm_inlet_data%VAL_VEL(2) = vy
276 ebcs%fvm_inlet_data%FUNC_VEL(3) = ivz
277 ebcs%fvm_inlet_data%VAL_VEL(3) = vz
278 check_cumul_vf(1:2) = zero
279
280 CALL hm_get_intv('matLawArrCnt',nbmat,is_available,lsubmodel)
281 ebcs%NBMAT = nbmat
282
283 DO imat = 1, nbmat
284 CALL hm_get_float_array_index('Fscalevf_n', alpha ,imat,is_available,lsubmodel,unitab)
285 CALL hm_get_float_array_index('Fscalerho_n',rho ,imat,is_available,lsubmodel,unitab)
286 CALL hm_get_float_array_index('Fscalep_e_n',pres ,imat,is_available,lsubmodel,unitab)
287 CALL hm_get_int_array_index('fct_IDvf_n', ialpha,imat,is_available,lsubmodel)
288 CALL hm_get_int_array_index('fct_IDrho_n', irho ,imat,is_available,lsubmodel)
289 CALL hm_get_int_array_index('fct_IDp_e_n', ipres ,imat,is_available,lsubmodel)
290 IF(sub_index /= 0 ) THEN
291 off_def = lsubmodel(sub_index)%OFF_DEF
292 IF(ialpha > 0) ialpha = ialpha + off_def
293 IF(irho > 0) irho = irho + off_def
294 IF(ipres > 0) ipres = ipres + off_def
295 ENDIF
296 check_cumul_vf(1)=check_cumul_vf(1)+abs(ialpha)
297 check_cumul_vf(2)=check_cumul_vf(2)+abs(alpha)
298 !user ids backup
299 u_ialpha=ialpha
300 u_irho =irho
301 u_ipres =ipres
302 !check and get internal function id
303 IF(ialpha > 0)THEN
304 found = .false.
305 DO j=1,nfunct
306 IF(ialpha==npc(j)) THEN
307 ialpha=j
308 found=.true.
309 EXIT
310 ENDIF
311 ENDDO
312 IF(.NOT.found)THEN
313 chain='SUBMAT-00'
314 write(chain(8:9),'(i2)')imat
315 chain1='INVALID FUNCTION ID FOR IALPHA & '//chain
316 CALL ancmsg(msgid=1602, msgtype=msgerror, anmode=aninfo, i1=id, c1=trim(titr), c2=chain1)
317 ENDIF
318 ENDIF
319 !check and get internal function id
320 IF(irho > 0)THEN
321 found = .false.
322 DO j=1,nfunct
323 IF(irho == npc(j)) THEN
324 irho=j
325 found=.true.
326 EXIT
327 ENDIF
328 ENDDO
329 IF(.NOT.found)THEN
330 chain='SUBMAT-00'
331 write(chain(8:9),'(i2)')imat
332 chain1='INVALID FUNCTION ID FOR IRHO & '//chain
333 CALL ancmsg(msgid=1602, msgtype=msgerror, anmode=aninfo, i1=id, c1=trim(titr), c2=chain1)
334 ENDIF
335 ENDIF
336 !check and get internal function id
337 IF(ipres > 0)THEN
338 found = .false.
339 DO j=1,nfunct
340 IF(ipres == npc(j)) THEN
341 ipres=j
342 found=.true.
343 EXIT
344 ENDIF
345 ENDDO
346 IF(.NOT.found)THEN
347 chain='SUBMAT-00'
348 write(chain(8:9),'(i2)')imat
349 chain1='INVALID FUNCTION ID FOR IPRES & '//chain
350 CALL ancmsg(msgid=1602, msgtype=msgerror, anmode=aninfo, i1=id, c1=trim(titr), c2=chain1)
351 ENDIF
352 ENDIF
353 IF(alpha < zero)THEN
354 CALL ancmsg(msgid=1602, msgtype=msgerror, anmode=aninfo, i1=id, c1=trim(titr), c2= "VOLUME FRACTION CANNOT BE NEGATIVE")
355 ENDIF
356 IF(rho < zero)THEN
357 CALL ancmsg(msgid=1602, msgtype=msgerror, anmode=aninfo, i1=id, c1=trim(titr), c2= "MASS DENSITY CANNOT BE NEGATIVE")
358 ENDIF
359 ebcs%fvm_inlet_data%FUNC_ALPHA(imat) = ialpha
360 ebcs%fvm_inlet_data%FUNC_RHO(imat) = irho
361 ebcs%fvm_inlet_data%FUNC_PRES(imat) = ipres
362 ebcs%fvm_inlet_data%VAL_ALPHA(imat) = alpha
363 ebcs%fvm_inlet_data%VAL_RHO(imat) = rho
364 ebcs%fvm_inlet_data%VAL_PRES(imat) = pres
365 WRITE(iout,1130)imat
366 WRITE(iout,1131)u_ialpha,u_irho,u_ipres
367 WRITE(iout,1132)alpha,rho,pres
368 ENDDO
369 WRITE(iout, fmt='(/)' )
370 IF(check_cumul_vf(1) == zero .AND. check_cumul_vf(2) == zero)THEN
371 CALL ancmsg(msgid=1602, msgtype=msgerror, anmode=aninfo,i1=id, c1=trim(titr), c2= "INPUT VOLUME FRACTIONS ARE EMPTY")
372 ENDIF
373
374
375 WRITE(iout,1118)surf,nseg
376
377C-----------
378 RETURN
379C-----------
380 1018 FORMAT( //'FLUID INLET EBCS NUMBER . . . . . . . . :',i8,1x,a)
381 1021 FORMAT( ' VELOCITY & PRESSURE')
382 1022 FORMAT( ' VELOCITY & ENERGY')
383 1118 FORMAT(
384 . ' ON SURFACE . . . . . . . . . . . . . . . ',i8,/,
385 . ' NUMBER OF SEGMENTS FOUND. . . . . . . . . ',i8,/)
386 1121 FORMAT(
387 . ' IVx FUNCTION ID . . . . . . . . . . . . . ',i8,/,
388 . ' Vx SCALE FACTOR . . . . . . . . . . . . . ',e16.6)
389 1122 FORMAT(
390 . ' IVy FUNCTION ID . . . . . . . . . . . . . ',i8,/,
391 . ' Vy SCALE FACTOR . . . . . . . . . . . . . ',e16.6)
392 1123 FORMAT(
393 . ' IVz FUNCTION ID . . . . . . . . . . . . . ',i8,/,
394 . ' Vz SCALE FACTOR . . . . . . . . . . . . . ',e16.6)
395 1124 FORMAT(
396 . ' IVx FUNCTION ID . . . . . . . . . . . . . ',i2)
397 1125 FORMAT(
398 . ' IVy FUNCTION ID . . . . . . . . . . . . . ',i2)
399 1126 FORMAT(
400 . ' IVz FUNCTION ID . . . . . . . . . . . . . ',i2)
401 1127 FORMAT(
402 . ' IVx FUNCTION ID . . . . . . . . . . . . . ',i2,/,
403 . ' Von Neumann BCS : d/dn(Vx) = 0')
404 1128 FORMAT(
405 . ' IVy FUNCTION ID . . . . . . . . . . . . . ',i2,/,
406 . ' Von Neumann BCS : d/dn(Vy) = 0')
407 1129 FORMAT(
408 . ' IVz FUNCTION ID . . . . . . . . . . . . . ',i2,/,
409 . ' Von Neumann BCS : d/dn(Vz) = 0')
410
411 1130 FORMAT(
412 . /,' SUBMAT-',i2)
413 1131 FORMAT(
414 . ' IALPHA FUNCTION. . . . . . . . . . . . .',i8,/,
415 . ' IRHO FUNCTION. . . . . . . . . . . . . .',i8,/,
416 . ' IPRES FUNCTION. . . . . . . . . . . . . ',i8)
417 1132 FORMAT(
418 . ' ALPHA SCALE FACTOR . . . . . . . . . . .',e16.6,/,
419 . ' RHO SCALE FACTOR . . . . . . . . . . . .',e16.6,/,
420 . ' PRES SCALE FUNCTION . . . . . . . . . . ',e16.6)
421 1133 FORMAT(
422 . ' IVn FUNCTION ID . . . . . . . . . . . . . ',i8,/,
423 . ' Vn SCALE FACTOR . . . . . . . . . . . . . ',e16.6)
424 1134 FORMAT(
425 . ' Vn CONSTANT VELOCITY. . . . . . . . . . . ',e16.6)
426 1135 FORMAT(
427 . ' IVn FUNCTION ID . . . . . . . . . . . . . ',i2,/,
428 . ' Von Neumann BCS : d/dn Vn = 0')
429
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:418
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:528
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:323
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:895