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 groupdef_mod
46 USE submodel_mod
47 USE ebcs_mod
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.NOT. IF(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.NOT. IF(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.NOT. IF(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.AND. IF(CHECK_CUMUL_VF(1) == ZERO 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
430 END
431
#define my_real
Definition cppsort.cpp:32
#define alpha
Definition eval.h:35
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine hm_read_ebcs_inlet(igrsurf, npc, multi_fvm, unitab, id, titr, uid, lsubmodel, key2, sub_index, ebcs)
for(i8=*sizetab-1;i8 >=0;i8--)
integer, parameter nchartitle
integer, parameter ncharkey
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:323
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
subroutine velocity(a, ar, v, vr, fzero, itab, nale)
Definition velocity.F:29