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!|| ebcs_cyclic_surface_matching ../starter/source/boundary_conditions/ebcs/ebcs_cyclic_surface_matching.F90
30!|| findele ../starter/source/boundary_conditions/ebcs/findele.F
31!|| icinvs ../starter/source/boundary_conditions/ebcs/iniebcs.F
32!|| iface ../starter/source/ale/ale3d/iface.F
33!||--- uses -----------------------------------------------------
34!|| ebcs_cyclic_surface_matching_mod ../starter/source/boundary_conditions/ebcs/ebcs_cyclic_surface_matching.F90
35!|| message_mod ../starter/share/message_module/message_mod.F
36!||====================================================================
37 SUBROUTINE iniebcs(ALE_CONNECTIVITY, IFLAG,IGRSURF, IXS, IXQ, IXTG,
38 . PM, IGEO, X, SENSORS, IVOLU, MULTI_FVM_IS_USED, EBCS_TAB, EBCS_TAG_CELL_SPMD,ITAB)
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE groupdef_mod
43 USE message_mod
44 USE ale_ebcs_mod
45 USE ebcs_mod
46 USE ale_connectivity_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
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 "param_c.inc"
58#include "com01_c.inc"
59#include "com04_c.inc"
60#include "tabsiz_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
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(NUMELQ+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
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
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 !< ALE/EULER framework flag
83 INTEGER IMID, IPID !< material and property iid
84 INTEGER, DIMENSION(:, :), POINTER :: IX
85 INTEGER :: NIX
86 INTEGER :: ISU2, IDSU2
87 INTEGER :: NELEM
88 integer, target :: nothing(1,1) !< dummy for indirection
89C=======================================================================
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
126 DO i = 1, nebcs
127 ebcs => ebcs_tab%tab(i)%poly
128 typ = ebcs%type
129 isu = ebcs%surf_id
130 id = ebcs%ebcs_id
131 nseg = ebcs%nb_elem
132 SELECT TYPE (ebcs)
133 TYPE IS (t_ebcs_gradp0)
134 ! vold
135 ebcs%has_vold = .true.
136 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
137 ebcs%vold(1:ebcs%nb_node) = zero
138 ! pold
139 ebcs%has_pold = .true.
140 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
141 ebcs%pold(1:ebcs%nb_node) = zero
142 ! p0
143 ebcs%has_p0 = .true.
144 IF(iflag==0)ALLOCATE(ebcs%p0(ebcs%nb_node))
145 ebcs%p0(1:ebcs%nb_node) = zero
146 ! iface
147 ebcs%has_iface = .true.
148 IF(iflag==0)ALLOCATE(ebcs%iface(ebcs%nb_elem))
149 ebcs%iface(1:ebcs%nb_elem) = 0
150 ! la
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 ! reso
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 ! ro0
160 ebcs%has_ro0 = .true.
161 IF(iflag==0)ALLOCATE(ebcs%ro0(ebcs%nb_elem))
162 ebcs%ro0(1:ebcs%nb_elem) = zero
163 ! en0
164 ebcs%has_en0 = .true.
165 IF(iflag==0)ALLOCATE(ebcs%en0(ebcs%nb_elem))
166 ebcs%en0(1:ebcs%nb_elem) = zero
167 ! v0
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 ! la
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 ! vold
177 ebcs%has_vold = .true.
178 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
179 ebcs%vold(1:ebcs%nb_node) = zero
180 ! pold
181 ebcs%has_pold = .true.
182 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
183 ebcs%pold(1:ebcs%nb_node) = zero
184 ! la
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 ! vold
190 ebcs%has_vold = .true.
191 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
192 ebcs%vold(1:ebcs%nb_node) = zero
193 ! pold
194 ebcs%has_pold = .true.
195 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
196 ebcs%pold(1:ebcs%nb_node) = zero
197 ! la
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 ! vold
203 ebcs%has_vold = .true.
204 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
205 ebcs%vold(1:ebcs%nb_node) = zero
206 ! pold
207 ebcs%has_pold = .true.
208 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
209 ebcs%pold(1:ebcs%nb_node) = zero
210 ! la
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 ! reso
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 ! la
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 ! reso
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 ! la
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 ! ro0
234 ebcs%has_ro0 = .true.
235 IF(iflag==0)ALLOCATE(ebcs%ro0(ebcs%nb_elem))
236 ebcs%ro0(1:ebcs%nb_elem) = zero
237 ! en0
238 ebcs%has_en0 = .true.
239 IF(iflag==0)ALLOCATE(ebcs%en0(ebcs%nb_elem))
240 ebcs%en0(1:ebcs%nb_elem) = zero
241 ! p0
242 ebcs%has_p0 = .true.
243 IF(iflag==0)ALLOCATE(ebcs%p0(ebcs%nb_node))
244 ebcs%p0(1:ebcs%nb_node) = zero
245 ! vold
246 ebcs%has_vold = .true.
247 IF(iflag==0)ALLOCATE(ebcs%vold(ebcs%nb_node))
248 ebcs%vold(1:ebcs%nb_node) = zero
249 ! pold
250 ebcs%has_pold = .true.
251 IF(iflag==0)ALLOCATE(ebcs%pold(ebcs%nb_node))
252 ebcs%pold(1:ebcs%nb_node) = zero
253 ! la
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 ! la
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 ! area
283 ebcs%has_area = .true.
284 IF(iflag==0)ALLOCATE(ebcs%area(ebcs%nb_elem))
285 ebcs%area(1:ebcs%nb_elem) = zero
286 ! dvnf
287 ebcs%has_dvnf = .true.
288 IF(iflag==0)ALLOCATE(ebcs%dvnf(ebcs%nb_elem))
289 ebcs%dvnf(1:ebcs%nb_elem) = zero
290 ! ng
291 ebcs%has_ng = .true.
292 IF(iflag==0)ALLOCATE(ebcs%ng(ebcs%nb_elem))
293 ebcs%ng(1:ebcs%nb_elem) = 0
294 ! iloc
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 ! iface
310 ebcs%has_iface = .true.
311 IF(iflag==0)ALLOCATE(ebcs%iface(nseg))
312 ebcs%iface(1:nseg) = 0
313 ! vold
314 ebcs%has_vold = .true.
315 IF(iflag==0)ALLOCATE(ebcs%vold(siz))
316 ebcs%vold(1:siz) = 0
317 ! Pold
318 ebcs%has_Pold = .true.
319 IF(iflag==0) ALLOCATE(ebcs%Pold(siz))
320 ebcs%Pold(1:siz) = 0
321 ! la
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 ! dp0
326 ebcs%has_dp0 = .true.
327 IF(iflag==0)ALLOCATE(ebcs%dp0(nseg))
328 ebcs%dp0(1:nseg) = zero
329
330 TYPE IS (t_ebcs_propellant)
331 ! iface
332 ebcs%has_iface = .true.
333 IF(iflag==0)ALLOCATE(ebcs%iface(nseg))
334 ebcs%iface(1:nseg) = 0
335 ! la
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 ! dp0
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 ! iface
346 ebcs%has_iface = .true.
347 IF(iflag==0)ALLOCATE(ebcs%iface(2*nseg))
348 ebcs%iface(1:2*nseg) = 0
349 ! la
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 ! ng
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 ! iloc
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 ! second suface treatment for /EBCS/CYCLIC
381 ! use same storage but starting from nseg+1 (allocation done with 2*nseg)
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 ! check link between two surfaces and order faces consequently
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 !2D quads & trias EBCS : all on domain 1 (ispmd=0) --> TAG with EBCS_TAG_CELL_SPMD
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 !tag elem to send to domain #1
423 ENDDO
424 !-------------------------------------------------
425
426 ENDIF
427
428 ! check that based element has ALE or EULER framework
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 !error message (printed one time only : iflag == 0)
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)
450C-----------
451 RETURN
452 END
453C
454!||====================================================================
455!|| icinvs ../starter/source/boundary_conditions/ebcs/iniebcs.F
456!||--- called by ------------------------------------------------------
457!|| iniebcs ../starter/source/boundary_conditions/ebcs/iniebcs.F
458!||====================================================================
459 SUBROUTINE icinvs(NNODE, NELEM, NIX, IX, IADD, INVC)
460C
461C-----------------------------------------------
462C I m p l i c i t T y p e s
463C-----------------------------------------------
464#include "implicit_f.inc"
465C-----------------------------------------------
466C C o m m o n B l o c k s
467C-----------------------------------------------
468#include "com04_c.inc"
469C-----------------------------------------------
470C D u m m y A r g u m e n t s
471C-----------------------------------------------
472 INTEGER, INTENT(IN) :: NNODE, NELEM, NIX, IX(NIX, *)
473 INTEGER, INTENT(OUT) :: IADD(*), INVC(*)
474C-----------------------------------------------
475C L o c a l V a r i a b l e s
476C-----------------------------------------------
477 INTEGER I, J, N
478C-----------------------------------------------
479 iadd(1) = 1
480 iadd(2) = 1
481C
482 DO i=3,numnod+1
483 iadd(i)=0
484 ENDDO
485C
486 DO j = 2, 1 + nnode
487 DO i=1,nelem
488 n = ix(j,i) + 2
489 iadd(n)=iadd(n)+1
490 ENDDO
491 ENDDO
492C
493 DO i=3,numnod+1
494 iadd(i)=iadd(i)+iadd(i-1)
495 ENDDO
496 DO j=2, 1 + nnode
497 DO i=1,nelem
498 n = ix(j,i) + 1
499 invc(iadd(n)) = i
500 iadd(n) = iadd(n) + 1
501 ENDDO
502 ENDDO
503 RETURN
504 END
505
my_real
#define my_real
Definition cppsort.cpp:32
findele
subroutine findele(ale_connectivity, nnode, nix, idsu, id, nseg, numel, ix, iseg, iele, itype, ifac, surf_nodes, iadd, invc, pm, x, type, igeo, itab)
Definition findele.F:38
icinvs
subroutine icinvs(nnode, nelem, nix, ix, iadd, invc)
Definition iniebcs.F:460
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, itab)
Definition iniebcs.F:39
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
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:668
message_mod
Definition message_mod.F:1257
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
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:256