OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_ebcs.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!|| read_ebcs ../starter/source/boundary_conditions/ebcs/read_ebcs.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
30!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
31!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.f
32!|| hm_read_ebcs_cyclic ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_cyclic.F90
33!|| hm_read_ebcs_fluxout ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_fluxout.F
34!|| hm_read_ebcs_gradp0 ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_gradp0.F
35!|| hm_read_ebcs_inip ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_inip.F
36!|| hm_read_ebcs_iniv ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_iniv.F
37!|| hm_read_ebcs_inlet ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_inlet.F
38!|| hm_read_ebcs_monvol ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_monvol.F
39!|| hm_read_ebcs_normv ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_normv.F
40!|| hm_read_ebcs_nrf ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_nrf.F
41!|| hm_read_ebcs_pres ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_pres.F
42!|| hm_read_ebcs_propellant ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_propellant.F90
43!|| hm_read_ebcs_valvin ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_valvin.F
44!|| hm_read_ebcs_valvout ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_valvout.F
45!|| hm_read_ebcs_vel ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_vel.F
46!|| ifrontplus ../starter/source/spmd/node/frontplus.F
47!||--- uses -----------------------------------------------------
48!|| front_mod ../starter/share/modules1/front_mod.F
49!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
50!|| hm_read_ebcs_cyclic_mod ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_cyclic.F90
51!|| hm_read_ebcs_propellant_mod ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_propellant.F90
52!|| message_mod ../starter/share/message_module/message_mod.F
53!|| restmod ../starter/share/modules1/restart_mod.F
54!|| submodel_mod ../starter/share/modules1/submodel_mod.F
55!|| table_mod ../starter/share/modules1/table_mod.f
56!||====================================================================
57 SUBROUTINE read_ebcs(IGRSURF,MULTI_FVM,NPC1,LSUBMODEL,EBCS_TAB,N2D)
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE front_mod
62 USE unitab_mod
63 USE message_mod
64 USE multi_fvm_mod
65 USE groupdef_mod
66 USE restmod
67 USE table_mod
68 USE submodel_mod
69 USE ale_ebcs_mod
70 USE ebcs_mod
73 use hm_read_ebcs_propellant_mod, only : hm_read_ebcs_propellant
74 use hm_read_ebcs_cyclic_mod, only : hm_read_ebcs_cyclic
75C-----------------------------------------------
76C I m p l i c i t T y p e s
77C-----------------------------------------------
78#include "implicit_f.inc"
79C-----------------------------------------------
80C C o m m o n B l o c k s
81C-----------------------------------------------
82#include "units_c.inc"
83#include "com04_c.inc"
84#include "titr_c.inc"
85C-----------------------------------------------
86C D u m m y A r g u m e n t s
87C-----------------------------------------------
88 TYPE (SURF_), DIMENSION(NSURF), TARGET, INTENT(IN) :: IGRSURF
89 TYPE (MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
90 INTEGER, INTENT(IN) :: NPC1
91 TYPE(submodel_data) LSUBMODEL(NSUBMOD)
92 TYPE(t_ebcs_tab), INTENT(INOUT) :: EBCS_TAB
93 INTEGER,INTENT(IN) :: N2D
94C-----------------------------------------------
95C L o c a l V a r i a b l e s
96C-----------------------------------------------
97 INTEGER :: LOCAL_ID
98 INTEGER :: ID,TYP,UID,SURF_ID2
99 INTEGER :: II, SURF_ID, JJ, SUB_INDEX
100 CHARACTER(LEN=NCHARTITLE) :: TITR
101 CHARACTER(LEN=NCHARKEY) :: KEY, KEY2
102 LOGICAL :: IS_AVAILABLE, IS_EBCS_PARALLEL
103C-----------------------------------------------
104C S o u r c e L i n e s
105C-----------------------------------------------
106
107 IF (nebcs > 0) THEN
108 WRITE(iout,1000)
109 WRITE(istdo,'(A)')titre(69)
110 CALL ebcs_tab%CREATE(nebcs) ! Create structure for collecting ebcs
111 CALL hm_option_start('/EBCS') ! Prepare data structures
112 ENDIF
113
114
115 DO ii = 1, nebcs
116 local_id = ii
117 CALL hm_option_read_key(lsubmodel, option_id = id, unit_id = uid, option_titr = titr,
118 . keyword2 = key, keyword3 = key2, submodel_index = sub_index)
119! Allocate type
120 SELECT CASE(key(1:len_trim(key)))
121 CASE ('GRADP0')
122
123 typ = 0
124 allocate (t_ebcs_gradp0 :: ebcs_tab%tab(ii)%poly)
125 select type (twf => ebcs_tab%tab(ii)%poly)
126 type is (t_ebcs_gradp0)
127 CALL hm_read_ebcs_gradp0(igrsurf, npc1, multi_fvm, unitab, id, titr, lsubmodel, twf)
128 end select
129
130 CASE ('PRES')
131
132 typ = 1
133 allocate (t_ebcs_pres :: ebcs_tab%tab(ii)%poly)
134 select type (twf => ebcs_tab%tab(ii)%poly)
135 type is (t_ebcs_pres)
136 CALL hm_read_ebcs_pres(igrsurf, npc1, multi_fvm, unitab, id, titr, lsubmodel, twf)
137 end select
138
139 CASE ('VALVIN')
140
141 typ = 2
142 allocate (t_ebcs_valvin :: ebcs_tab%tab(ii)%poly)
143 select type (twf => ebcs_tab%tab(ii)%poly)
144 type is (t_ebcs_valvin)
145 CALL hm_read_ebcs_valvin(igrsurf, npc1, multi_fvm, unitab, id, titr, lsubmodel, twf)
146 end select
147
148 CASE ('VALVOUT')
149
150 typ = 3
151 allocate (t_ebcs_valvout :: ebcs_tab%tab(ii)%poly)
152 select type (twf => ebcs_tab%tab(ii)%poly)
153 type is (t_ebcs_valvout)
154 CALL hm_read_ebcs_valvout( igrsurf, npc1, multi_fvm, unitab, id, titr, lsubmodel, twf)
155 end select
156
157 CASE ('VEL')
158
159 typ = 4
160 allocate (t_ebcs_vel :: ebcs_tab%tab(ii)%poly)
161 select type (twf => ebcs_tab%tab(ii)%poly)
162 type is (t_ebcs_vel)
163 CALL hm_read_ebcs_vel(igrsurf, npc1, multi_fvm, unitab, id, titr, lsubmodel, twf)
164 end select
165
166 CASE ('NORMV')
167
168 typ = 5
169 allocate (t_ebcs_normv :: ebcs_tab%tab(ii)%poly)
170 select type (twf => ebcs_tab%tab(ii)%poly)
171
172 type is (t_ebcs_normv)
173 CALL hm_read_ebcs_normv( igrsurf, npc1, multi_fvm, unitab, id, titr, lsubmodel, twf)
174 end select
175
176 CASE ('INIP')
177
178 typ = 6
179 allocate (t_ebcs_inip :: ebcs_tab%tab(ii)%poly)
180 select type (twf => ebcs_tab%tab(ii)%poly)
181 type is (t_ebcs_inip)
182 CALL hm_read_ebcs_inip(igrsurf, multi_fvm, unitab, id, titr, lsubmodel, twf)
183 end select
184
185 CASE ('INIV')
186
187 typ = 7
188 allocate (t_ebcs_iniv :: ebcs_tab%tab(ii)%poly)
189 select type (twf => ebcs_tab%tab(ii)%poly)
190 type is (t_ebcs_iniv)
191 CALL hm_read_ebcs_iniv(igrsurf, multi_fvm, unitab, id, titr, lsubmodel, twf)
192 end select
193
194 CASE ('INLET')
195
196 typ = 8
197 allocate (t_ebcs_inlet :: ebcs_tab%tab(ii)%poly)
198 select type (twf => ebcs_tab%tab(ii)%poly)
199 type is (t_ebcs_inlet)
200 CALL hm_read_ebcs_inlet(igrsurf, npc1, multi_fvm, unitab, id, titr, uid, lsubmodel, key2, sub_index, twf)
201 end select
202
203 CASE ('fluxout')
204
205 TYP = 9
206 allocate (t_ebcs_fluxout :: EBCS_TAB%tab(ii)%poly)
207 select type (twf => EBCS_TAB%tab(ii)%poly)
208 type is (t_ebcs_fluxout)
209 CALL HM_READ_EBCS_FLUXOUT(IGRSURF, MULTI_FVM, UNITAB, ID, TITR, UID, LSUBMODEL, twf)
210 end select
211
212 CASE ('nrf')
213
214 TYP = 10
215 allocate (t_ebcs_nrf :: EBCS_TAB%tab(ii)%poly)
216 select type (twf => EBCS_TAB%tab(ii)%poly)
217 type is (t_ebcs_nrf)
218 CALL HM_READ_EBCS_NRF(IGRSURF, MULTI_FVM, UNITAB, ID, TITR, UID, LSUBMODEL, twf)
219 end select
220
221 CASE ('propellant')
222
223 TYP = 11
224 allocate (t_ebcs_propellant :: EBCS_TAB%tab(ii)%poly)
225 select type (twf => EBCS_TAB%tab(ii)%poly)
226 type is (t_ebcs_propellant)
227 CALL HM_READ_EBCS_PROPELLANT(IGRSURF, MULTI_FVM, UNITAB, ID, TITR, UID, LSUBMODEL,NSURF, twf)
228 end select
229
230 CASE ('cyclic')
231
232 TYP = 12
233 allocate (t_ebcs_cyclic :: EBCS_TAB%tab(ii)%poly)
234 select type (twf => EBCS_TAB%tab(ii)%poly)
235 type is (t_ebcs_cyclic)
236 CALL HM_READ_EBCS_CYCLIC(IGRSURF, MULTI_FVM, ID, TITR, LSUBMODEL,NSURF, twf, N2D, numnod, itab )
237 end select
238
239 CASE ('monvol')
240
241 TYP = 100
242 allocate (t_ebcs_monvol :: EBCS_TAB%tab(ii)%poly)
243 select type (twf => EBCS_TAB%tab(ii)%poly)
244 type is (t_ebcs_monvol)
245 CALL HM_READ_EBCS_MONVOL(IGRSURF,MULTI_FVM,UNITAB, ID, TITR, UID, LSUBMODEL, twf)
246 end select
247
248 CASE DEFAULT
249 TYP = 0
250 CALL ANCMSG(MSGID = 1602, MSGTYPE = MSGERROR, ANMODE = ANINFO,
251 . I1 = ID, C1 = TRIM(TITR), C2 = "\'"//TRIM(KEY)//"\'"//" IS NOT A VALID KEYWORD FOR EBCS OPTIONS")
252 END SELECT
253
254 EBCS_TAB%tab(II)%poly%type = TYP
255 EBCS_TAB%tab(II)%poly%ebcs_id = ID
256 ! Get surface ID
257 CALL HM_GET_INTV('entityid', SURF_ID, IS_AVAILABLE, LSUBMODEL)
258 JJ = -HUGE(JJ)
259 IF (SURF_ID > 0) THEN
260 EBCS_TAB%tab(II)%poly%surf_id = 0
261 DO JJ = 1, NSURF
262 IF (IGRSURF(JJ)%ID == SURF_ID) THEN
263 EBCS_TAB%tab(II)%poly%surf_id = JJ
264 EXIT
265 ENDIF
266 ENDDO
267 ENDIF
268 IF (EBCS_TAB%tab(II)%poly%surf_id > 0) THEN
269 CALL EBCS_TAB%tab(II)%poly%set_nodes_elems(IGRSURF(JJ)%NSEG, NUMNOD, IGRSURF(JJ)%NODES)
270 !secondary surface with EBCS/CYCLIC
271 IF(EBCS_TAB%tab(II)%poly%type == 12)then
272 surf_id2 = EBCS_TAB%tab(II)%poly%surf_id2
273 CALL EBCS_TAB%tab(II)%poly%set_nodes_elems_secondary_surface(IGRSURF(surf_id2)%NSEG, NUMNOD, IGRSURF(surf_id2)%NODES)
274 endif
275
276 IS_EBCS_PARALLEL = .FALSE.
277.OR. IF(EBCS_TAB%tab(II)%poly%type == 10 EBCS_TAB%tab(II)%poly%type == 11)THEN
278 IS_EBCS_PARALLEL = .TRUE.
279 ENDIF
280
281.NOT. IF( IS_EBCS_PARALLEL) THEN
282 DO JJ = 1, EBCS_TAB%tab(II)%poly%nb_node
283 CALL IFRONTPLUS(EBCS_TAB%tab(II)%poly%node_list(jj), 1)
284 ENDDO
285 ENDIF
286
287 DO JJ = 1, EBCS_TAB%tab(II)%poly%nb_node
288 FLAGKIN(EBCS_TAB%tab(II)%poly%node_list(jj)) = 1
289 ENDDO
290
291 ELSE
292 ! error
293 ENDIF
294
295 ENDDO
296
297 RETURN
298 1000 FORMAT(
299 & 5X,' elementary boundary conditions'/,
300 & 5X,' ------------------------------')
301 END SUBROUTINE
subroutine hm_option_start(entity_type)
subroutine hm_read_ebcs_gradp0(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
subroutine hm_read_ebcs_inip(igrsurf, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
subroutine hm_read_ebcs_iniv(igrsurf, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
subroutine hm_read_ebcs_inlet(igrsurf, npc, multi_fvm, unitab, id, titr, uid, lsubmodel, key2, sub_index, ebcs)
subroutine hm_read_ebcs_normv(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
subroutine hm_read_ebcs_pres(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
subroutine hm_read_ebcs_valvin(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
subroutine hm_read_ebcs_valvout(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
subroutine hm_read_ebcs_vel(igrsurf, npc, multi_fvm, unitab, id, titr, lsubmodel, ebcs)
integer nebcs
integer, parameter nchartitle
integer, parameter ncharkey
type(unit_type_) unitab
integer, dimension(:), allocatable monvol
Definition restart_mod.F:60
subroutine read_ebcs(igrsurf, multi_fvm, npc1, lsubmodel, ebcs_tab, n2d)
Definition read_ebcs.F:58
program starter
Definition starter.F:39