OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
iniebcs.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!|| iniebcs ../starter/source/boundary_conditions/ebcs/iniebcs.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| findele ../starter/source/boundary_conditions/ebcs/findele.f
30!|| icinvs ../starter/source/boundary_conditions/ebcs/iniebcs.F
31!|| iface ../starter/source/ale/ale3d/iface.F
32!||--- uses -----------------------------------------------------
33!|| message_mod ../starter/share/message_module/message_mod.F
34!||====================================================================
35 SUBROUTINE iniebcs(ALE_CONNECTIVITY, IFLAG,IGRSURF, IXS, IXQ, IXTG,
36 . PM, IGEO, X, SENSORS, IVOLU, MULTI_FVM_IS_USED, EBCS_TAB, EBCS_TAG_CELL_SPMD)
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE groupdef_mod
41 USE message_mod
42 USE ale_ebcs_mod
43 USE ebcs_mod
44 USE ale_connectivity_mod
45 USE sensor_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "param_c.inc"
54#include "com01_c.inc"
55#include "com04_c.inc"
56#include "tabsiz_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
61 INTEGER,INTENT(IN),TARGET :: IXS(NIXS,SIXS/NIXS),IXQ(NIXQ,SIXQ/NIXQ),IXTG(NIXTG,SIXTG/NIXTG)
62 INTEGER, INTENT(IN) :: IVOLU(NIMV,*)
63 LOGICAL, INTENT(IN) :: MULTI_FVM_IS_USED
64 INTEGER, INTENT(INOUT) :: EBCS_TAG_CELL_SPMD(NUMELQ+NUMELTG+NUMELS)
65 my_real,INTENT(IN) :: pm(npropm,nummat),x(sx)
66 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
67 TYPE(t_ebcs_tab), TARGET, INTENT(INOUT) :: EBCS_TAB
68 INTEGER,INTENT(IN) :: IFLAG, IGEO(NPROPGI,NUMGEO)
69 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER, DIMENSION(:), ALLOCATABLE :: MWA
74 INTEGER I,TYP,ID,ISU,NSEG,IDSU,K1,SENS,VOLU,J,KK,LENMWA,ERR,ICELL
75 INTEGER :: SIZ
76 class(t_ebcs), POINTER :: ebcs
77 INTEGER :: JALE_FROM_MAT, JALE_FROM_PROP, IS_ALE_EULER !< ALE/EULER framework flag
78 INTEGER IMID, IPID !< material and property iid
79 INTEGER, DIMENSION(:, :), POINTER :: IX
80 INTEGER :: NIX
81 integer, target :: nothing(1,1) !< dummy for indirection
82C=======================================================================
83 ebcs_tag_cell_spmd(1:numelq+numeltg+numels)=0
84 ix => nothing
85 nix = 0
86 icell = 0
87 IF (n2d == 0) THEN
88 lenmwa = numnod+2+8*numels
89 ALLOCATE(mwa(lenmwa), stat=err)
90 IF(err /= 0) THEN
91 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='EBCS')
92 ENDIF
93 CALL icinvs(8, numels, nixs, ixs, mwa, mwa(1+(2+numnod)))
94 ix => ixs(1:nixs, 1:numels)
95 nix = nixs
96 ELSEIF (numelq /= 0) THEN
97 lenmwa = numnod + 2 + 4 * numelq
98 ALLOCATE(mwa(lenmwa), stat=err)
99 IF(err /= 0) THEN
100 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='EBCS')
101 ENDIF
102 CALL icinvs(4, numelq, nixq, ixq, mwa, mwa(1+(2+numnod)))
103 ix => ixq(1:nixq, 1:numelq)
104 nix = nixq
105 ELSEIF (numeltg /= 0 .AND. multi_fvm_is_used) THEN
106 lenmwa = numnod + 2 + 3 * numeltg
107 ALLOCATE(mwa(lenmwa), stat=err)
108 IF(err /= 0) THEN
109 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='EBCS')
110 ENDIF
111 CALL icinvs(3, numeltg, nixtg, ixtg, mwa, mwa(1+(2+numnod)))
112 ix => ixtg(1:nixtg, 1:numeltg)
113 nix = nixtg
114 ENDIF
115
116 DO i = 1, nebcs
117 ebcs => ebcs_tab%tab(i)%poly
118 typ = ebcs%type
119 isu = ebcs%surf_id
120 id = ebcs%ebcs_id
121 nseg = ebcs%nb_elem
122 SELECT TYPE (ebcs)
123 TYPE IS (t_ebcs_gradp0)
124 ! vold
125 ebcs%has_vold = .true.
126 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
127 ebcs%vold(1:ebcs%nb_node) = zero
128 ! pold
129 ebcs%has_pold = .true.
130 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
131 ebcs%pold(1:ebcs%nb_node) = zero
132 ! p0
133 ebcs%has_p0 = .true.
134 IF(iflag==0)ALLOCATE(ebcs%p0(ebcs%nb_node))
135 ebcs%p0(1:ebcs%nb_node) = zero
136 ! iface
137 ebcs%has_iface = .true.
138 IF(iflag==0)ALLOCATE(ebcs%iface(ebcs%nb_elem))
139 ebcs%iface(1:ebcs%nb_elem) = 0
140 ! la
141 ebcs%has_la = .true.
142 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
143 ebcs%la(1:3, 1:ebcs%nb_node) = zero
144 TYPE IS (t_ebcs_iniv)
145 ! reso
146 ebcs%has_reso = .true.
147 IF(iflag==0)ALLOCATE(ebcs%reso(3, ebcs%nb_node))
148 ebcs%reso(1:3, 1:ebcs%nb_node) = zero
149 ! ro0
150 ebcs%has_ro0 = .true.
151 IF(iflag==0)ALLOCATE(ebcs%ro0(ebcs%nb_elem))
152 ebcs%ro0(1:ebcs%nb_elem) = zero
153 ! en0
154 ebcs%has_en0 = .true.
155 IF(iflag==0)ALLOCATE(ebcs%en0(ebcs%nb_elem))
156 ebcs%en0(1:ebcs%nb_elem) = zero
157 ! v0
158 ebcs%has_v0 = .true.
159 IF(iflag==0)ALLOCATE(ebcs%v0(3, ebcs%nb_node))
160 ebcs%v0(1:3, 1:ebcs%nb_node) = zero
161 ! la
162 ebcs%has_la = .true.
163 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
164 ebcs%la(1:3, 1:ebcs%nb_node) = zero
165 TYPE IS (t_ebcs_pres)
166 ! vold
167 ebcs%has_vold = .true.
168 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
169 ebcs%vold(1:ebcs%nb_node) = zero
170 ! pold
171 ebcs%has_pold = .true.
172 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
173 ebcs%pold(1:ebcs%nb_node) = zero
174 ! la
175 ebcs%has_la = .true.
176 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
177 ebcs%la(1:3, 1:ebcs%nb_node) = zero
178 TYPE IS (t_ebcs_valvin)
179 ! vold
180 ebcs%has_vold = .true.
181 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
182 ebcs%vold(1:ebcs%nb_node) = zero
183 ! pold
184 ebcs%has_pold = .true.
185 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
186 ebcs%pold(1:ebcs%nb_node) = zero
187 ! la
188 ebcs%has_la = .true.
189 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
190 ebcs%la(1:3, 1:ebcs%nb_node) = zero
191 TYPE IS (t_ebcs_valvout)
192 ! vold
193 ebcs%has_vold = .true.
194 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
195 ebcs%vold(1:ebcs%nb_node) = zero
196 ! pold
197 ebcs%has_pold = .true.
198 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
199 ebcs%pold(1:ebcs%nb_node) = zero
200 ! la
201 ebcs%has_la = .true.
202 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
203 ebcs%la(1:3, 1:ebcs%nb_node) = zero
204 TYPE IS(t_ebcs_vel)
205 ! reso
206 ebcs%has_reso = .true.
207 IF(iflag==0)ALLOCATE(ebcs%reso(3, ebcs%nb_node))
208 ebcs%reso(1:3, 1:ebcs%nb_node) = zero
209 ! la
210 ebcs%has_la = .true.
211 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
212 ebcs%la(1:3, 1:ebcs%nb_node) = zero
213 TYPE IS(t_ebcs_normv)
214 ! reso
215 ebcs%has_reso = .true.
216 IF(iflag==0)ALLOCATE(ebcs%reso(3, ebcs%nb_node))
217 ebcs%reso(1:3, 1:ebcs%nb_node) = zero
218 ! la
219 ebcs%has_la = .true.
220 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
221 ebcs%la(1:3, 1:ebcs%nb_node) = zero
222 TYPE IS (t_ebcs_inip)
223 ! ro0
224 ebcs%has_ro0 = .true.
225 IF(iflag==0)ALLOCATE(ebcs%ro0(ebcs%nb_elem))
226 ebcs%ro0(1:ebcs%nb_elem) = zero
227 ! en0
228 ebcs%has_en0 = .true.
229 IF(iflag==0)ALLOCATE(ebcs%en0(ebcs%nb_elem))
230 ebcs%en0(1:ebcs%nb_elem) = zero
231 ! p0
232 ebcs%has_p0 = .true.
233 IF(iflag==0)ALLOCATE(ebcs%p0(ebcs%nb_node))
234 ebcs%p0(1:ebcs%nb_node) = zero
235 ! vold
236 ebcs%has_vold = .true.
237 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
238 ebcs%vold(1:ebcs%nb_node) = zero
239 ! pold
240 ebcs%has_pold = .true.
241 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
242 ebcs%pold(1:ebcs%nb_node) = zero
243 ! la
244 ebcs%has_la = .true.
245 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
246 ebcs%la(1:3, 1:ebcs%nb_node) = zero
247 TYPE IS (t_ebcs_monvol)
248 volu = ebcs%monvol_id
249 sens = ebcs%sensor_id
250 DO j = 1, nvolu
251 IF (volu == ivolu(1,j))THEN
252 volu = ivolu(1,j)
253 ebcs%monvol_id = volu
254 ENDIF
255 ENDDO
256 IF(iflag==1)THEN
257 DO j = 1, sensors%NSENSOR
258 IF (sens == sensors%SENSOR_TAB(j)%SENS_ID)THEN
259 ebcs%monvol_id = sens
260 ENDIF
261 ENDDO
262 ENDIF
263 TYPE IS (t_ebcs_inlet)
264 ebcs%has_iface = .true.
265 IF(iflag==0)ALLOCATE(ebcs%iface(ebcs%nb_elem))
266 ebcs%iface(1:ebcs%nb_elem) = 0
267 TYPE IS (t_ebcs_fluxout)
268 ebcs%has_iface = .true.
269 IF(iflag==0)ALLOCATE(ebcs%iface(ebcs%nb_elem))
270 ebcs%iface(1:ebcs%nb_elem) = 0
271 TYPE IS (t_ebcs_nrf)
272 IF(ebcs%is_multifluid) THEN
273 siz = ebcs%nb_elem
274 ELSE
275 siz = ebcs%nb_node
276 ENDIF
277 ! iface
278 ebcs%has_iface = .true.
279 IF(iflag==0)ALLOCATE(ebcs%iface(nseg))
280 ebcs%iface(1:nseg) = 0
281 ! vold
282 ebcs%has_vold = .true.
283 IF(iflag==0)ALLOCATE(ebcs%vold(siz))
284 ebcs%vold(1:siz) = 0
285 ! Pold
286 ebcs%has_Pold = .true.
287 IF(iflag==0) ALLOCATE(ebcs%Pold(siz))
288 ebcs%Pold(1:siz) = 0
289 ! la
290 ebcs%has_la = .true.
291 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
292 ebcs%la(1:3, 1:ebcs%nb_node) = zero
293 ! dp0
294 ebcs%has_dp0 = .true.
295 IF(iflag==0)ALLOCATE(ebcs%dp0(nseg))
296 ebcs%dp0(1:nseg) = zero
297
298 TYPE IS (t_ebcs_propellant)
299 IF(ebcs%is_multifluid) THEN
300 siz = ebcs%nb_elem
301 ELSE
302 siz = ebcs%nb_node
303 ENDIF
304 ! iface
305 ebcs%has_iface = .true.
306 IF(iflag==0)ALLOCATE(ebcs%iface(nseg))
307 ebcs%iface(1:nseg) = 0
308 ! vold
309 ebcs%has_vold = .true.
310 IF(iflag==0)ALLOCATE(ebcs%vold(siz))
311 ebcs%vold(1:siz) = 0
312 ! Pold
313 ebcs%has_Pold = .true.
314 IF(iflag==0) ALLOCATE(ebcs%Pold(siz))
315 ebcs%Pold(1:siz) = 0
316 ! la
317 ebcs%has_la = .true.
318 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
319 ebcs%la(1:3, 1:ebcs%nb_node) = zero
320 ! dp0
321 ebcs%has_dp0 = .true.
322 IF(iflag==0)ALLOCATE(ebcs%dp0(nseg))
323 ebcs%dp0(1:nseg) = zero
324
325 END SELECT
326
327 IF(isu>0)THEN
328 idsu = igrsurf(isu)%ID
329 IF (n2d == 0) THEN
330 CALL findele(ale_connectivity, 8, nixs, idsu,id,nseg,ixs,
331 . ebcs%iseg, ebcs%ielem, ebcs%itype,ebcs%iface,
332 . igrsurf(isu)%NODES,mwa,mwa(1+(2+numnod)),pm,x,typ,igeo)
333 ELSEIF (numelq /= 0) THEN
334 CALL findele(ale_connectivity, 4, nixq, idsu,id,nseg,ixq,
335 . ebcs%iseg, ebcs%ielem,ebcs%itype, ebcs%iface,
336 . igrsurf(isu)%NODES,mwa,mwa(1+(2+numnod)),pm,x,typ,igeo)
337 ELSEIF (numeltg /= 0 .AND. multi_fvm_is_used) THEN
338 CALL findele(ale_connectivity, 3, nixtg, idsu,id,nseg,ixtg,
339 . ebcs%iseg, ebcs%ielem,ebcs%itype, ebcs%iface,
340 . igrsurf(isu)%NODES,mwa,mwa(1+(2+numnod)),pm,x,typ,igeo)
341 ENDIF
342
343 IF(.NOT.ebcs%is_multifluid .AND. (typ == 0 .OR. typ == 10 .OR. typ == 11))THEN
344 !2D quads & trias EBCS : all on domain 1 (ispmd=0) --> TAG with EBCS_TAG_CELL_SPMD
345 !-------------------------------------------------
346 DO kk=1,ebcs%nb_elem
347 icell = ebcs%ielem(kk)
348 k1=0
349 IF (ebcs%itype(kk)==4)k1=0
350 IF (ebcs%itype(kk)==3)k1=numelq
351 IF (ebcs%itype(kk)==8)k1=numelq+numeltg
352 IF(typ/=10 .AND. typ /= 11) ebcs_tag_cell_spmd(k1+icell)=1 !tag elem to send to domain #1
353 ENDDO
354 !-------------------------------------------------
355
356 ENDIF
357
358 ! check that based element has ALE or EULER framework
359 DO kk=1,ebcs%NB_ELEM
360 icell = ebcs%IELEM(kk)
361 imid=ix(1,icell)
362 ipid=ix(nix-1,icell)
363 jale_from_mat = int(pm(72,imid))
364 jale_from_prop = igeo(62,ipid)
365 is_ale_euler = jale_from_mat + jale_from_prop
366 IF(is_ale_euler == 0 .AND. iflag == 0)THEN
367 !error message (printed one time only : iflag == 0)
368 CALL ancmsg(msgid=1602,msgtype=msgerror,anmode=aninfo,i1 = ebcs%ebcs_id,c1 = trim(ebcs%title),
369 . c2 = "EBCS ARE ONLY COMPATIBLE WITH ALE OR EULER FRAMEWORK")
370 exit
371 ENDIF
372 ENDDO
373
374
375
376 ENDIF
377 ENDDO
378
379 IF (ALLOCATED(mwa)) DEALLOCATE(mwa)
380C-----------
381 RETURN
382 END
383C
384!||====================================================================
385!|| icinvs ../starter/source/boundary_conditions/ebcs/iniebcs.F
386!||--- called by ------------------------------------------------------
387!|| iniebcs ../starter/source/boundary_conditions/ebcs/iniebcs.F
388!||====================================================================
389 SUBROUTINE icinvs(NNODE, NELEM, NIX, IX, IADD, INVC)
390C
391C-----------------------------------------------
392C I m p l i c i t T y p e s
393C-----------------------------------------------
394#include "implicit_f.inc"
395C-----------------------------------------------
396C C o m m o n B l o c k s
397C-----------------------------------------------
398#include "com04_c.inc"
399C-----------------------------------------------
400C D u m m y A r g u m e n t s
401C-----------------------------------------------
402 INTEGER, INTENT(IN) :: NNODE, NELEM, NIX, IX(NIX, *)
403 INTEGER, INTENT(OUT) :: IADD(*), INVC(*)
404C-----------------------------------------------
405C L o c a l V a r i a b l e s
406C-----------------------------------------------
407 INTEGER I, J, N
408C-----------------------------------------------
409 iadd(1) = 1
410 iadd(2) = 1
411C
412 DO i=3,numnod+1
413 iadd(i)=0
414 ENDDO
415C
416 DO j = 2, 1 + nnode
417 DO i=1,nelem
418 n = ix(j,i) + 2
419 iadd(n)=iadd(n)+1
420 ENDDO
421 ENDDO
422C
423 DO i=3,numnod+1
424 iadd(i)=iadd(i)+iadd(i-1)
425 ENDDO
426 DO j=2, 1 + nnode
427 DO i=1,nelem
428 n = ix(j,i) + 1
429 invc(iadd(n)) = i
430 iadd(n) = iadd(n) + 1
431 ENDDO
432 ENDDO
433 RETURN
434 END
435
my_real
#define my_real
Definition cppsort.cpp:32
findele
subroutine findele(ale_connectivity, nnode, nix, idsu, id, nseg, ix, iseg, iele, itype, ifac, surf_nodes, iadd, invc, pm, x, type, igeo)
Definition findele.F:38
icinvs
subroutine icinvs(nnode, nelem, nix, ix, iadd, invc)
Definition iniebcs.F:390
iniebcs
subroutine iniebcs(ale_connectivity, iflag, igrsurf, ixs, ixq, ixtg, pm, igeo, x, sensors, ivolu, multi_fvm_is_used, ebcs_tab, ebcs_tag_cell_spmd)
Definition iniebcs.F:37
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
ale_ebcs_mod
Definition ale_ebcs_mod.F:40
ale_ebcs_mod::nebcs
integer nebcs
Definition ale_ebcs_mod.F:43
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
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
starter
program starter
Definition starter.F:39
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:254