39
40
41
45 USE ebcs_mod
47 USE sensor_mod
48 use element_mod , only : nixs,nixc,nixq,nixtg
49 USE ebcs_cyclic_surface_matching_mod, ONLY : ebcs_cyclic_surface_matching
50
51
52
53#include "implicit_f.inc"
54
55
56
57#include "param_c.inc"
58#include "com01_c.inc"
59#include "com04_c.inc"
60#include "tabsiz_c.inc"
61
62
63
64 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
65 INTEGER,INTENT(IN) :: ITAB(NUMNOD)
66 INTEGER,INTENT(IN),TARGET :: IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),IXTG(NIXTG,NUMELTG)
67 INTEGER, INTENT(IN) :: IVOLU(NIMV,*)
68 LOGICAL, INTENT(IN) :: MULTI_FVM_IS_USED
69 INTEGER, INTENT(INOUT) :: EBCS_TAG_CELL_SPMD(+NUMELTG+NUMELS)
70 my_real,
INTENT(IN) :: pm(npropm,nummat),x(sx)
71 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
72 TYPE(t_ebcs_tab), TARGET, INTENT(INOUT) :: EBCS_TAB
73 INTEGER,INTENT(IN) :: IFLAG, IGEO(NPROPGI,NUMGEO)
74 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
75
76
77
78 INTEGER, DIMENSION(:), ALLOCATABLE :: MWA
79 INTEGER I,TYP,ID,ISU,NSEG,IDSU,K1,SENS,VOLU,J,KK,LENMWA,ERR,ICELL
80 INTEGER :: SIZ
81 class(t_ebcs), POINTER :: ebcs
82 INTEGER :: JALE_FROM_MAT, JALE_FROM_PROP, IS_ALE_EULER
83 INTEGER IMID, IPID
84 INTEGER, DIMENSION(:, :), POINTER :: IX
85 INTEGER :: NIX
86 INTEGER :: ISU2, IDSU2
87 INTEGER :: NELEM
88 integer, target :: nothing(1,1)
89
90 ebcs_tag_cell_spmd(1:numelq+numeltg+numels)=0
91 ix => nothing
92 nix = 0
93 icell = 0
94 IF (n2d == 0) THEN
95 lenmwa = numnod+2+8*numels
96 ALLOCATE(mwa(lenmwa), stat=err)
97 IF(err /= 0) THEN
98 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'EBCS')
99 ENDIF
100 CALL icinvs(8, numels, nixs, ixs, mwa, mwa(1+(2+numnod)))
101 ix => ixs(1:nixs, 1:numels)
102 nix = nixs
103 nelem = numels
104 ELSEIF (numelq /= 0) THEN
105 lenmwa = numnod + 2 + 4 * numelq
106 ALLOCATE(mwa(lenmwa), stat=err)
107 IF(err /= 0) THEN
108 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'EBCS')
109 ENDIF
110 CALL icinvs(4, numelq, nixq, ixq, mwa, mwa(1+(2+numnod)))
111 ix => ixq(1:nixq, 1:numelq)
112 nix = nixq
113 nelem = numelq
114 ELSEIF (numeltg /= 0 .AND. multi_fvm_is_used) THEN
115 lenmwa = numnod + 2 + 3 * numeltg
116 ALLOCATE(mwa(lenmwa), stat=err)
117 IF(err /= 0) THEN
118 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1=
'EBCS')
119 ENDIF
120 CALL icinvs(3, numeltg, nixtg, ixtg, mwa, mwa(1+(2+numnod)))
121 ix => ixtg(1:nixtg, 1:numeltg)
122 nix = nixtg
123 nelem = numeltg
124 ENDIF
125
127 ebcs => ebcs_tab%tab(i)%poly
128 typ = ebcs%type
129 isu = ebcs%surf_id
131 nseg = ebcs%nb_elem
132 SELECT TYPE (ebcs)
133 TYPE IS (t_ebcs_gradp0)
134
135 ebcs%has_vold = .true.
136 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
137 ebcs%vold(1:ebcs%nb_node) = zero
138
139 ebcs%has_pold = .true.
140 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
141 ebcs%pold(1:ebcs%nb_node) = zero
142
143 ebcs%has_p0 = .true.
144 IF(iflag==0)ALLOCATE(ebcs%p0(ebcs%nb_node))
145 ebcs%p0(1:ebcs%nb_node) = zero
146
147 ebcs%has_iface = .true.
148 IF(iflag==0)ALLOCATE(ebcs%iface(ebcs%nb_elem))
149 ebcs%iface(1:ebcs%nb_elem) = 0
150
151 ebcs%has_la = .true.
152 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
153 ebcs%la(1:3, 1:ebcs%nb_node) = zero
154 TYPE IS (t_ebcs_iniv)
155
156 ebcs%has_reso = .true.
157 IF(iflag==0)ALLOCATE(ebcs%reso(3, ebcs%nb_node))
158 ebcs%reso(1:3, 1:ebcs%nb_node) = zero
159
160 ebcs%has_ro0 = .true.
161 IF(iflag==0)ALLOCATE(ebcs%ro0(ebcs%nb_elem))
162 ebcs%ro0(1:ebcs%nb_elem) = zero
163
164 ebcs%has_en0 = .true.
165 IF(iflag==0)ALLOCATE(ebcs%en0(ebcs%nb_elem))
166 ebcs%en0(1:ebcs%nb_elem) = zero
167
168 ebcs%has_v0 = .true.
169 IF(iflag==0)ALLOCATE(ebcs%v0(3, ebcs%nb_node))
170 ebcs%v0(1:3, 1:ebcs%nb_node) = zero
171
172 ebcs%has_la = .true.
173 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
174 ebcs%la(1:3, 1:ebcs%nb_node) = zero
175 TYPE IS (t_ebcs_pres)
176
177 ebcs%has_vold = .true.
178 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
179 ebcs%vold(1:ebcs%nb_node) = zero
180
181 ebcs%has_pold = .true.
182 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
183 ebcs%pold(1:ebcs%nb_node) = zero
184
185 ebcs%has_la = .true.
186 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
187 ebcs%la(1:3, 1:ebcs%nb_node) = zero
188 TYPE IS (t_ebcs_valvin)
189
190 ebcs%has_vold = .true.
191 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
192 ebcs%vold(1:ebcs%nb_node) = zero
193
194 ebcs%has_pold = .true.
195 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
196 ebcs%pold(1:ebcs%nb_node) = zero
197
198 ebcs%has_la = .true.
199 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
200 ebcs%la(1:3, 1:ebcs%nb_node) = zero
201 TYPE IS (t_ebcs_valvout)
202
203 ebcs%has_vold = .true.
204 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
205 ebcs%vold(1:ebcs%nb_node) = zero
206
207 ebcs%has_pold = .true.
208 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
209 ebcs%pold(1:ebcs%nb_node) = zero
210
211 ebcs%has_la = .true.
212 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
213 ebcs%la(1:3, 1:ebcs%nb_node) = zero
214 TYPE IS(t_ebcs_vel)
215
216 ebcs%has_reso = .true.
217 IF(iflag==0)ALLOCATE(ebcs%reso(3, ebcs%nb_node))
218 ebcs%reso(1:3, 1:ebcs%nb_node) = zero
219
220 ebcs%has_la = .true.
221 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
222 ebcs%la(1:3, 1:ebcs%nb_node) = zero
223 TYPE IS(t_ebcs_normv)
224
225 ebcs%has_reso = .true.
226 IF(iflag==0)ALLOCATE(ebcs%reso(3, ebcs%nb_node))
227 ebcs%reso(1:3, 1:ebcs%nb_node) = zero
228
229 ebcs%has_la = .true.
230 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
231 ebcs%la(1:3, 1:ebcs%nb_node) = zero
232 TYPE IS (t_ebcs_inip)
233
234 ebcs%has_ro0 = .true.
235 IF(iflag==0)ALLOCATE(ebcs%ro0(ebcs%nb_elem))
236 ebcs%ro0(1:ebcs%nb_elem) = zero
237
238 ebcs%has_en0 = .true.
239 IF(iflag==0)ALLOCATE(ebcs%en0(ebcs%nb_elem))
240 ebcs%en0(1:ebcs%nb_elem) = zero
241
242 ebcs%has_p0 = .true.
243 IF(iflag==0)ALLOCATE(ebcs%p0(ebcs%nb_node))
244 ebcs%p0(1:ebcs%nb_node) = zero
245
246 ebcs%has_vold = .true.
247 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
248 ebcs%vold(1:ebcs%nb_node) = zero
249
250 ebcs%has_pold = .true.
251 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
252 ebcs%pold(1:ebcs%nb_node) = zero
253
254 ebcs%has_la = .true.
255 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
256 ebcs%la(1:3, 1:ebcs%nb_node) = zero
257 TYPE IS (t_ebcs_monvol)
258 volu = ebcs%monvol_id
259 sens = ebcs%sensor_id
260 DO j = 1, nvolu
261 IF (volu == ivolu(1,j))THEN
262 volu = ivolu(1,j)
263 ebcs%monvol_id = volu
264 ENDIF
265 ENDDO
266 IF(iflag==1)THEN
267 DO j = 1, sensors%NSENSOR
268 IF (sens == sensors%SENSOR_TAB(j)%SENS_ID)THEN
269 ebcs%monvol_id = sens
270 ENDIF
271 ENDDO
272 ENDIF
273 TYPE IS (t_ebcs_inlet)
274 ebcs%has_iface = .true.
275 IF(iflag==0)ALLOCATE(ebcs%iface(ebcs%nb_elem))
276 ebcs%iface(1:ebcs%nb_elem) = 0
277 IF(.NOT. multi_fvm_is_used)THEN
278
279 ebcs%has_la = .true.
280 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
281 ebcs%la(1:3, 1:ebcs%nb_node) = zero
282
283 ebcs%has_area = .true.
284 IF(iflag==0)ALLOCATE(ebcs%area(ebcs%nb_elem))
285 ebcs%area(1:ebcs%nb_elem) = zero
286
287 ebcs%has_dvnf = .true.
288 IF(iflag==0)ALLOCATE(ebcs%dvnf(ebcs%nb_elem))
289 ebcs%dvnf(1:ebcs%nb_elem) = zero
290
291 ebcs%has_ng = .true.
292 IF(iflag==0)ALLOCATE(ebcs%ng(ebcs%nb_elem))
293 ebcs%ng(1:ebcs%nb_elem) = 0
294
295 ebcs%has_iloc = .true.
296 IF(iflag==0)ALLOCATE(ebcs%iloc(ebcs%nb_elem))
297 ebcs%iloc(1:ebcs%nb_elem) = 0
298 ENDIF
299 TYPE IS (t_ebcs_fluxout)
300 ebcs%has_iface = .true.
301 IF(iflag==0)ALLOCATE(ebcs%iface(ebcs%nb_elem))
302 ebcs%iface(1:ebcs%nb_elem) = 0
303 TYPE IS (t_ebcs_nrf)
304 IF(ebcs%is_multifluid) THEN
305 siz = ebcs%nb_elem
306 ELSE
307 siz = ebcs%nb_node
308 ENDIF
309
310 ebcs%has_iface = .true.
311 IF(iflag==0)ALLOCATE(ebcs%iface(nseg))
312 ebcs%iface(1:nseg) = 0
313
314 ebcs%has_vold = .true.
315 IF(iflag==0)ALLOCATE(ebcs%vold(siz))
316 ebcs%vold(1:siz) = 0
317
318 ebcs%has_Pold = .true.
319 IF(iflag==0) ALLOCATE(ebcs%Pold
320 ebcs%Pold(1:siz) = 0
321
322 ebcs%has_la = .true.
323 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
324 ebcs%la(1:3, 1:ebcs%nb_node) = zero
325
326 ebcs%has_dp0 = .true.
327 IF(iflag==0)ALLOCATE(ebcs%dp0
328 ebcs%dp0(1:nseg) = zero
329
330 TYPE IS (t_ebcs_propellant)
331
332 ebcs%has_iface = .true.
333 IF(iflag==0)ALLOCATE(ebcs%iface(nseg))
334 ebcs%iface(1:nseg) = 0
335
336 ebcs%has_la = .true.
337 IF(iflag==0)ALLOCATE(ebcs%la(3, ebcs%nb_node))
338 ebcs%la(1:3, 1:ebcs%nb_node) = zero
339
340 ebcs%has_dp0 = .true.
341 IF(iflag==0)ALLOCATE(ebcs%dp0(nseg))
342 ebcs%dp0(1:nseg) = zero
343
344 TYPE IS (t_ebcs_cyclic)
345
346 ebcs%has_iface = .true.
347 IF(iflag==0)ALLOCATE(ebcs%iface(2*nseg))
348 ebcs%iface(1:2*nseg) = 0
349
350 ebcs%has_la = .true.
351 IF(iflag==0)ALLOCATE(ebcs%la(3, 2*ebcs%nb_node))
352 ebcs%la(1:3, 1:2*ebcs%nb_node) = zero
353
354 ebcs%has_ng = .true.
355 IF(iflag==0)ALLOCATE(ebcs%ng(2*ebcs%nb_elem))
356 ebcs%ng(1:2*ebcs%nb_elem) = 0
357
358 ebcs%has_iloc = .true.
359 IF(iflag==0)ALLOCATE(ebcs%iloc(2*ebcs%nb_elem))
360 ebcs%iloc(1:2*ebcs%nb_elem) = 0
361
362 END SELECT
363
364 IF(isu>0)THEN
365 idsu = igrsurf(isu)%ID
366 IF (n2d == 0) THEN
367 CALL findele(ale_connectivity, 8, nixs, idsu,
id,nseg,nelem,ixs,
368 . ebcs%iseg, ebcs%ielem, ebcs%itype,ebcs%iface,
369 . igrsurf(isu)%NODES,mwa,mwa(1+(2+numnod)),pm,x,typ,igeo,itab)
370 ELSEIF (numelq /= 0) THEN
371 CALL findele(ale_connectivity, 4, nixq, idsu,
id,nseg,nelem,ixq,
372 . ebcs%iseg, ebcs%ielem,ebcs%itype, ebcs%iface,
373 . igrsurf(isu)%NODES,mwa,mwa(1+(2+numnod)),pm,x,typ,igeo,itab)
374 ELSEIF (numeltg /= 0) THEN
375 CALL findele(ale_connectivity, 3, nixtg, idsu,
id,nseg,nelem,ixtg,
376 . ebcs%iseg, ebcs%ielem,ebcs%itype, ebcs%iface,
377 . igrsurf(isu)%NODES,mwa,mwa(1+(2+numnod)),pm,x,typ,igeo,itab)
378 ENDIF
379
380
381
382 IF(ebcs%TYPE == 12)THEN
383 select type (twf => ebcs_tab%tab(i)%poly)
384 TYPE IS (t_ebcs_cyclic)
385 isu2 = twf%surf_id2
386 IF(isu2>0)THEN
387 idsu2 = igrsurf(isu2)%ID
388 IF (n2d == 0) THEN
389 CALL findele(ale_connectivity, 8, nixs, idsu2,
id,nseg,nelem,ixs,
390 . ebcs%iseg(nseg+1), ebcs%ielem(nseg+1), ebcs%itype(nseg+1),ebcs%iface(nseg+1),
391 . igrsurf(isu2)%NODES,mwa,mwa(1+(2+numnod)),pm,x,typ,igeo,itab)
392 ELSEIF (numelq /= 0) THEN
393 CALL findele(ale_connectivity, 4, nixq, idsu2,
id,nseg,nelem,ixq,
394 . ebcs%iseg(nseg+1), ebcs%ielem(nseg+1),ebcs%itype(nseg+1), ebcs%iface(nseg+1),
395 . igrsurf(isu2)%NODES,mwa,mwa(1+(2+numnod)),pm,x,typ,igeo,itab)
396 ELSEIF (numeltg /= 0) THEN
397 CALL findele(ale_connectivity, 3, nixtg, idsu2,
id,nseg,nelem,ixtg,
398 . ebcs%iseg(nseg+1), ebcs%ielem(nseg+1),ebcs%itype(nseg+1), ebcs%iface(nseg+1),
399 . igrsurf(isu2)%NODES,mwa,mwa(1+(2+numnod)),pm,x,typ,igeo,itab)
400 ENDIF
401
402 CALL ebcs_cyclic_surface_matching(twf, ebcs, n2d, numnod, x)
403 IF(iflag/=0)THEN
404 ebcs%NB_ELEM = 2*ebcs%NB_ELEM
405 ebcs%NB_NODE = 2*ebcs%NB_NODE
406 ENDIF
407 ENDIF
408 END SELECT
409 ENDIF
410
411
412
413 IF(.NOT.ebcs%is_multifluid .AND. (typ == 0 .OR. typ == 8 .OR. typ == 10 .OR. typ == 11))THEN
414
415
416 DO kk=1,ebcs%nb_elem
417 icell = ebcs%ielem(kk)
418 k1=0
419 IF (ebcs%itype(kk)==4)k1=0
420 IF (ebcs%itype(kk)==3)k1=numelq
421 IF (ebcs%itype(kk)==8)k1=numelq+numeltg
422 IF(typ/=10 .AND. typ /= 11) ebcs_tag_cell_spmd(k1+icell)=1
423 ENDDO
424
425
426 ENDIF
427
428
429 DO kk=1,ebcs%NB_ELEM
430 icell = ebcs%IELEM(kk)
431 imid=ix(1,icell)
432 ipid=ix(nix-1,icell)
433 jale_from_mat = int(pm(72,imid))
434 jale_from_prop = igeo(62,ipid)
435 is_ale_euler = jale_from_mat + jale_from_prop
436 IF(is_ale_euler == 0 .AND. iflag == 0)THEN
437
438 CALL ancmsg(msgid=1602,msgtype=msgerror,anmode=aninfo,i1 = ebcs%ebcs_id,c1 = trim(ebcs%title),
439 . c2 = "EBCS ARE ONLY COMPATIBLE WITH ALE OR EULER FRAMEWORK")
440 exit
441 ENDIF
442 ENDDO
443
444
445
446 ENDIF
447 ENDDO
448
449 IF (ALLOCATED(mwa)) DEALLOCATE(mwa)
450
451 RETURN
subroutine findele(ale_connectivity, nnode, nix, idsu, id, nseg, numel, ix, iseg, iele, itype, ifac, surf_nodes, iadd, invc, pm, x, type, igeo, itab)
subroutine icinvs(nnode, nelem, nix, ix, iadd, invc)
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)