OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvelinte_mod Module Reference

Functions/Subroutines

subroutine fvelinte (ibuf, elem, ixc, ixtg, pm, ipm, ilvout, ifv, nnt, ntg, porosity, nseg, surf_eltyp, ntgi, eltg, nb_node, surf_elem)

Function/Subroutine Documentation

◆ fvelinte()

subroutine fvelinte_mod::fvelinte ( integer, dimension(*) ibuf,
integer, dimension(3,*) elem,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
pm,
integer, dimension(npropmi,*) ipm,
integer ilvout,
integer ifv,
integer nnt,
integer ntg,
porosity,
integer nseg,
integer, dimension(*) surf_eltyp,
integer ntgi,
integer, dimension(*) eltg,
integer nb_node,
integer, dimension(*) surf_elem )

Definition at line 37 of file fvelinte.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE fvbag_mod
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com04_c.inc"
52#include "param_c.inc"
53#include "units_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER IXC(NIXC,*), IXTG(NIXTG,*), IPM(NPROPMI,*), ILVOUT, IFV
58 INTEGER IBUF(*), ELEM(3,*), NNT, NTG, SURF_ELTYP(*),SURF_ELEM(*)
59 INTEGER NSEG,NTGI, ELTG(*), NB_NODE
60 my_real pm(npropm,*), porosity(*)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I, II, J, JJ, ICMAX, NC, I1, I2, I3, IFOUND
65 INTEGER K, KK, ITY, N1, N2, N3, IEL, ILAW, MAT, LEAK
66 INTEGER J1, J2, J3, NNT_TMP
67 CHARACTER*6 TITL
68 INTEGER, DIMENSION(:,:), ALLOCATABLE :: CNS
69 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG,ITAGC,ITAGTG
70
71
72 ALLOCATE(itag(nb_node))
73 ALLOCATE(itagc(numelc))
74 ALLOCATE(itagtg(numeltg))
75C
76 DO i=1,nb_node
77 itag(i)=0
78 ENDDO
79
80C Number connected surface element to each node
81 DO i = 1, ntgi
82 n1 = elem(1, i)
83 n2 = elem(2, i)
84 n3 = elem(3, i)
85 n1 = ibuf(n1)
86 n2 = ibuf(n2)
87 n3 = ibuf(n3)
88 itag(n1) = itag(n1) + 1
89 itag(n2) = itag(n2) + 1
90 itag(n3) = itag(n3) + 1
91 ENDDO
92C Build connectivity
93 icmax = 0
94 DO i = 1, nb_node
95 icmax = max(icmax, itag(i))
96 ENDDO
97 DO i = 1, ntgi
98 n1 = elem(1, i)
99 n2 = elem(2, i)
100 n3 = elem(3, i)
101 n1 = ibuf(n1)
102 n2 = ibuf(n2)
103 n3 = ibuf(n3)
104 itag(n1) = 0
105 itag(n2) = 0
106 itag(n3) = 0
107 ENDDO
108 ALLOCATE(cns(nb_node,1+icmax*2))
109 DO i=1,nb_node
110 cns(i, 1)=0
111 ENDDO
112 DO i = 1, ntgi
113C Node 1
114 n1 = ibuf(elem(1, i))
115 nc = cns(n1, 1)
116 nc = nc + 1
117 cns(n1, 1) = nc
118 cns(n1, 1 + nc) = i
119C Node 2
120 n2 = ibuf(elem(2, i))
121 nc = cns(n2, 1)
122 nc = nc + 1
123 cns(n2, 1) = nc
124 cns(n2, 1 + nc) = i
125C Node 3
126 n3 = ibuf(elem(3, i))
127 nc = cns(n3, 1)
128 nc = nc + 1
129 cns(n3, 1) = nc
130 cns(n3, 1 + nc) = i
131 ENDDO
132
133 DO i=1,fvdata(ifv)%NNTR
134 iel=fvdata(ifv)%IFVTRI(4,i)
135 IF (iel == 0) THEN
136C Triangle interne appuye sur element solide
137 ifound=0
138 i1=fvdata(ifv)%IFVTRI(1,i)
139 i2=fvdata(ifv)%IFVTRI(2,i)
140 i3=fvdata(ifv)%IFVTRI(3,i)
141 n1=fvdata(ifv)%IFVNOD(1,i1)
142 n2=fvdata(ifv)%IFVNOD(1,i2)
143 n3=fvdata(ifv)%IFVNOD(1,i3)
144 IF(n1==2.AND.n2==2.AND.n3==2) THEN
145 i1=fvdata(ifv)%IFVNOD(2,i1)
146 i2=fvdata(ifv)%IFVNOD(2,i2)
147 i3=fvdata(ifv)%IFVNOD(2,i3)
148 itag(i1) = 1
149 itag(i2) = 1
150 itag(i3) = 1
151C Surface elements connected to node I1
152 DO j = 1, cns(i1,1)
153 n1 = ibuf(elem(1, cns(i1, 1 + j)))
154 n2 = ibuf(elem(2, cns(i1, 1 + j)))
155 n3 = ibuf(elem(3, cns(i1, 1 + j)))
156 IF (itag(n1) * itag(n2) * itag(n3) /= 0) THEN
157 fvdata(ifv)%IFVTRI(4,i) = -cns(i1, 1 + j)
158 ENDIF
159 ENDDO
160C reset tags
161 itag(i1) = 0
162 itag(i2) = 0
163 itag(i3) = 0
164 ENDIF
165 ENDIF
166 ENDDO
167
168 DEALLOCATE(cns)
169
170 DO i=1,numelc
171 itagc(i)=0
172 DO j=1,4
173 jj=ixc(1+j,i)
174 itag(jj)=itag(jj)+1
175 ENDDO
176 ENDDO
177 DO i=1,numeltg
178 itagtg(i)=0
179 DO j=1,3
180 jj=ixtg(1+j,i)
181 itag(jj)=itag(jj)+1
182 ENDDO
183 ENDDO
184C TAG elements of internal surface
185 DO i=1,nseg
186 ity=surf_eltyp(i)
187 ii =surf_elem(i)
188 IF(ity==3) itagc(ii)=1
189 IF(ity==7) itagtg(ii)=1
190 ENDDO
191
192 icmax=0
193 DO i=1,nb_node
194 icmax=max(icmax,itag(i))
195 ENDDO
196
197 ALLOCATE(cns(nb_node,1+icmax*2))
198 DO i=1,nb_node
199 cns(i,1)=0
200 ENDDO
201 DO i=1,numelc
202 IF(itagc(i)==0) cycle
203 DO j=1,4
204 jj=ixc(1+j,i)
205 nc=cns(jj,1)
206 nc=nc+1
207 cns(jj,1)=nc
208 cns(jj,1+2*(nc-1)+1)=1
209 cns(jj,1+2*(nc-1)+2)=i
210 ENDDO
211 ENDDO
212 DO i=1,numeltg
213 IF(itagtg(i)==0) cycle
214 DO j=1,3
215 jj=ixtg(1+j,i)
216 nc=cns(jj,1)
217 nc=nc+1
218 cns(jj,1)=nc
219 cns(jj,1+2*(nc-1)+1)=2
220 cns(jj,1+2*(nc-1)+2)=i
221 ENDDO
222 ENDDO
223
224 DO i=1,nb_node
225 itag(i) = 0
226 ENDDO
227
228 nnt_tmp = 0
229 DO i=1,fvdata(ifv)%NNTR
230 iel=fvdata(ifv)%IFVTRI(4,i)
231 IF (iel < 0) THEN
232C Triangle interne appuye sur element solide
233 ifound=0
234 i1=fvdata(ifv)%IFVTRI(1,i)
235 i2=fvdata(ifv)%IFVTRI(2,i)
236 i3=fvdata(ifv)%IFVTRI(3,i)
237 n1=fvdata(ifv)%IFVNOD(1,i1)
238 n2=fvdata(ifv)%IFVNOD(1,i2)
239 n3=fvdata(ifv)%IFVNOD(1,i3)
240 IF(n1==2.AND.n2==2.AND.n3==2) THEN
241 i1=fvdata(ifv)%IFVNOD(2,i1)
242 i2=fvdata(ifv)%IFVNOD(2,i2)
243 i3=fvdata(ifv)%IFVNOD(2,i3)
244 DO j=1,cns(i1,1)
245 ity=cns(i1,1+2*(j-1)+1)
246 jj=cns(i1,1+2*(j-1)+2)
247 IF (ity==1) THEN
248 DO k=1,4
249 kk=ixc(1+k,jj)
250 itag(kk)=1
251 ENDDO
252 IF (itag(i1)==1.AND.itag(i2)==1.AND.itag(i3)==1) THEN
253 ifound=jj
254 ENDIF
255 DO k=1,4
256 kk=ixc(1+k,jj)
257 itag(kk)=0
258 ENDDO
259 ELSEIF (ity==2) THEN
260 DO k=1,3
261 kk=ixtg(1+k,jj)
262 itag(kk)=1
263 ENDDO
264 IF (itag(i1)==1.AND.itag(i2)==1.AND.itag(i3)==1) THEN
265 ifound=numelc+jj
266 ENDIF
267 DO k=1,3
268 kk=ixtg(1+k,jj)
269 itag(kk)=0
270 ENDDO
271 ENDIF
272 IF (ifound /= 0) THEN
273 EXIT
274 ENDIF
275 ENDDO
276 IF(ifound/=0) THEN
277 fvdata(ifv)%IFVTRI(4,i)=-ifound
278 nnt_tmp = nnt_tmp + 1
279 ENDIF
280 ENDIF
281 ENDIF
282 ENDDO
283
284C REDEFINE INTERNAL TRIANGLE FOR COMPATIBILITY WITH BRICKS
285
286 DO i=1,nnt
287 j=ibuf(i)
288 itag(j)=i
289 ENDDO
290 ii=0
291 DO i=1,fvdata(ifv)%NNTR
292 ifound=fvdata(ifv)%IFVTRI(4,i)
293 IF(ifound<0) THEN
294 i1=fvdata(ifv)%IFVTRI(1,i)
295 i2=fvdata(ifv)%IFVTRI(2,i)
296 i3=fvdata(ifv)%IFVTRI(3,i)
297 j1=fvdata(ifv)%IFVNOD(1,i1)
298 j2=fvdata(ifv)%IFVNOD(1,i2)
299 j3=fvdata(ifv)%IFVNOD(1,i3)
300 IF(j1 == 2 .AND. j2==2 .AND. j3==2) THEN
301 n1=fvdata(ifv)%IFVNOD(2,i1)
302 n2=fvdata(ifv)%IFVNOD(2,i2)
303 n3=fvdata(ifv)%IFVNOD(2,i3)
304 ii=ii+1
305 elem(1,ii)=itag(n1)
306 elem(2,ii)=itag(n2)
307 elem(3,ii)=itag(n3)
308 fvdata(ifv)%IFVTRI(4,i)=-ntg-ii
309 eltg(ntg+ii)=-ifound
310 ENDIF
311 ENDIF
312 ENDDO
313
314C DEFINE POROSITY
315
316 IF(ilvout >= 1) WRITE(iout,1000)
317 DO i=1,ntgi
318 iel=eltg(ntg+i)
319 IF (iel<=numelc) THEN
320 mat =ixc(1,iel)
321 kk =ixc(nixc,iel)
322 titl='SHELL:'
323 ELSEIF (iel>numelc) THEN
324 jj=iel-numelc
325 mat =ixtg(1,jj)
326 kk =ixtg(nixtg,jj)
327 titl='SH3N: '
328 ENDIF
329
330 ilaw=ipm(2,mat)
331 leak=ipm(4,mat)
332 IF (ilaw == 0) THEN
333 porosity(i)=one
334 ELSEIF(ilaw == 19 .AND. leak == 0) THEN
335 porosity(i)=pm(56,mat)
336 ELSE
337 porosity(i)=zero
338 ENDIF
339 IF(ilvout >= 1) THEN
340 IF(ilaw == 58 .OR. (ilaw == 19 .AND. leak > 0)) THEN
341 WRITE(iout,1100) i,titl,kk,leak
342 ELSE
343 WRITE(iout,1150) i,titl,kk,porosity(i)
344 ENDIF
345 ENDIF
346 ENDDO
347
348 IF(ilvout >= 5) THEN
349 WRITE(iout,1200)
350 DO i=1,fvdata(ifv)%NNTR
351 i1=fvdata(ifv)%IFVTRI(1,i)
352 i2=fvdata(ifv)%IFVTRI(2,i)
353 i3=fvdata(ifv)%IFVTRI(3,i)
354 n1=fvdata(ifv)%IFVTRI(4,i)
355 n2=fvdata(ifv)%IFVTRI(5,i)
356 n3=fvdata(ifv)%IFVTRI(6,i)
357 WRITE(iout,'(5X,7I8)') i,i1,i2,i3,n1,n2,n3
358 ENDDO
359
360 WRITE(iout,1300)
361 DO i=1,fvdata(ifv)%NNS
362 n1=fvdata(ifv)%IFVNOD(1,i)
363 n2=fvdata(ifv)%IFVNOD(2,i)
364 n3=fvdata(ifv)%IFVNOD(3,i)
365 WRITE(iout,'(5X,4I8)') i,n1,n2,n3
366 ENDDO
367 ENDIF
368C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
369 1000 FORMAT(/5x,'FVMBAG INTERNAL ELEMENTS <-> SHELL or SH3N ',
370 . 3x,'POROSITY/ILEAKAGE'
371 . /5x,'----------------------------------------------------',
372 . '-----------')
373 1100 FORMAT( 5x,'TRIANGLE:',i8,' <-> ',a,i10,10x,i6)
374 1150 FORMAT( 5x,'TRIANGLE:',i8,' <-> ',a,i10,10x,f6.3)
375 1200 FORMAT(/5x,'TRIANGLE',9x,'NODES',10x,'ELEMENT',4x,'FINITE VOLUME')
376 1300 FORMAT(/5x,'FV POINT',4x,'FLAG',1x,'ELEM/NODE',2x,'NODE')
377
378 DEALLOCATE(cns)
379 DEALLOCATE(itag)
380 DEALLOCATE(itagc)
381 DEALLOCATE(itagtg)
382
383
384 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvdata
type(fvbag_data), dimension(:), allocatable fvdata
Definition fvbag_mod.F:128