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

Functions/Subroutines

subroutine fvbric1 (t_monvoln, ibuf, elem, ixs, tbric, nel, nela, nbric, tfac, tagels, monvid, neli, nna, ilvout, eltg, x, titr, nb_node)

Function/Subroutine Documentation

◆ fvbric1()

subroutine fvbric1_mod::fvbric1 ( type(monvol_struct_), intent(inout) t_monvoln,
integer, dimension(t_monvoln%nns + t_monvoln%nni), intent(in) ibuf,
integer, dimension(3, nel + neli), intent(inout) elem,
integer, dimension(nixs,*) ixs,
integer, dimension(2, nbric), intent(in) tbric,
integer nel,
integer nela,
integer nbric,
integer, dimension(12, nbric), intent(inout) tfac,
integer, dimension(nel + 2 * neli), intent(inout) tagels,
integer monvid,
integer neli,
integer nna,
integer ilvout,
integer, dimension(nel + neli), intent(in) eltg,
x,
character(len=nchartitle) titr,
integer nb_node )

Definition at line 41 of file fvbric1.F.

46 USE message_mod
47 USE monvol_struct_mod
48 USE names_and_titles_mod , ONLY : nchartitle
49 use element_mod , only : nixs
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 "units_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 TYPE(MONVOL_STRUCT_), INTENT(INOUT) :: T_MONVOLN
62 INTEGER IXS(NIXS,*),
63 . NEL, NELA, NBRIC,
64 . MONVID, NNA, ILVOUT,
65 . NELI, NB_NODE
66 INTEGER, DIMENSION(T_MONVOLN%NNS + T_MONVOLN%NNI), INTENT(IN) :: IBUF
67 INTEGER, DIMENSION(3, NEL + NELI), INTENT(INOUT) :: ELEM
68 INTEGER, DIMENSION(NEL + 2 * NELI), INTENT(INOUT) :: TAGELS
69 INTEGER, DIMENSION(2, NBRIC), INTENT(IN) :: TBRIC
70 INTEGER, DIMENSION(12, NBRIC), INTENT(INOUT) :: TFAC
71 INTEGER, DIMENSION(NEL + NELI), INTENT(IN) :: ELTG
72 my_real x(3,*)
73 CHARACTER(len=nchartitle) :: TITR
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER I, ITAG(NB_NODE), IAD, J, NFAC, NV, NALL,
78 . K, KK, L, JJ, II,
79 . ITAG2(NB_NODE), NALL2, LL, N1, N2, N3, N4,
80 . INFO, NFAC2, NN1, NN2, NN3, NN4,
81 . IERROR, ISPLIT, IFOUND, NTYPE, NTYPE2, NELT
82 my_real
83 . nsx, nsy, nsz, nex, ney, nez, ss, nsx2, nsy2, nsz2
84C
85 INTEGER, TARGET :: FAC4(3,4), FAC8(4,6), FAC6(4,5), NOD6(5)
86 INTEGER, TARGET :: FAC5(4,5), NOD5(5), NFACE(4), NOD8(6), NOD3(4)
87 DATA fac4 /1,5,3,
88 . 3,5,6,
89 . 6,5,1,
90 . 1,3,6/
91 DATA fac8 /1,4,3,2,
92 . 5,6,7,8,
93 . 1,2,6,5,
94 . 2,3,7,6,
95 . 3,4,8,7,
96 . 4,1,5,8/
97 DATA fac6 /1,3,2,0,
98 . 5,6,7,0,
99 . 1,2,6,5,
100 . 2,3,7,6,
101 . 3,4,8,7/
102 DATA nod6 /3,3,4,4,4/
103 DATA nod8 /4,4,4,4,4,4/
104 DATA nod3 /3,3,3,3/
105 DATA fac5 /1,2,5,0,
106 . 2,3,5,0,
107 . 3,4,5,0,
108 . 4,1,5,0,
109 . 1,4,3,2/
110 DATA nod5 /3,3,3,3,4/
111 DATA nface/6,4,5,5/
112 INTEGER, DIMENSION(:), ALLOCATABLE :: ADSKY, ADDCNET, CNT
113 INTEGER :: IAD1, IAD2, NODEID, TRIID
114 INTEGER :: NID(4), NID2(3)
115 INTEGER, DIMENSION(:, :), POINTER :: FAC
116 INTEGER, DIMENSION(:), POINTER :: NOD
117
118
119 !Initialize
120 fac => null()
121 nod => null()
122 nall = 0
123 ALLOCATE(addcnet(nb_node + 1), adsky(nb_node + 1))
124 DO i=1,nb_node
125 addcnet(i) = 0
126 itag(i)=0
127 itag2(i)=0
128 ENDDO
129 addcnet(nb_node + 1) = 0
130 nelt=nel+neli ! total number of triangles (surface + internal)
131 DO i=1,nelt
132 DO j=1,3
133 jj=ibuf(elem(j,i)) ! ELEM(J, I) = Node of triangle I, IBUF = Id of the node
134 itag(jj)=1 ! Tag the nodes of the triangles
135 addcnet(jj + 1) = addcnet(jj + 1) + 1
136 ENDDO
137 ENDDO
138
139 addcnet(1) = 1
140 DO i = 2, nb_node + 1
141 addcnet(i) = addcnet(i) + addcnet(i - 1)
142 ENDDO
143 DO i = 1, nb_node
144 adsky(i) = addcnet(i)
145 ENDDO
146C ============================
147C Node -> triangle connectivity
148C ============================
149 ALLOCATE(cnt(addcnet(nb_node + 1)))
150 DO i=1,nelt
151 DO j=1,3
152 jj=ibuf(elem(j,i)) ! ELEM(J, I) = Node of triangle I, IBUF = Id of the node
153 cnt(adsky(jj)) = i
154 adsky(jj) = adsky(jj) + 1
155 ENDDO
156 ENDDO
157
158C
159 isplit=0
160 10 ierror=0
161 info=0
162 nela=0
163 DO i=1,nbric
164 ii=tbric(1,i)
165 ntype=tbric(2,i)
166 nfac=nface(ntype)
167 SELECT CASE (ntype)
168 CASE (1)
169 fac => fac8(1:4, 1:6)
170 nod => nod8(1:6)
171 CASE (2)
172 fac => fac4(1:3, 1:4)
173 nod => nod3(1:4)
174 CASE (3)
175 fac => fac6(1:4, 1:5)
176 nod => nod6(1:5)
177 CASE (4)
178 fac => fac5(1:4, 1:5)
179 nod => nod5(1:5)
180 CASE DEFAULT
181 fac => fac5(1:4, 1:5)
182 nod => nod5(1:5)
183
184
185C ERROR
186 END SELECT
187 DO j=1,nfac
188 nall = 1
189 nid(1:4) = 0
190 DO k = 1, nod(j)
191 kk = fac(k, j)
192 nall = nall * itag(ixs(1+kk,ii))
193 nid(k) = ixs(1+kk,ii)
194 ENDDO
195C
196 IF (tfac(2*(j-1)+1,i)==0) THEN
197 IF (nall==1) THEN
198 tfac(2*(j-1)+1,i)=2
199 DO k = 1, nod(j)
200 kk = fac(k, j)
201 itag2(ixs(1+kk,ii))=1
202 ENDDO
203 CALL fvnormal(x, nid(1), nid(2), nid(3), nid(4), nsx, nsy, nsz)
204C Now check among all the triangles those who share their nodes with the considered face
205C Trick : useless to wander through the whole list, only elements connected to the nodes of
206C the face have to be considered
207 ifound = 0
208 DO k = 1, nod(j)
209 nodeid = nid(k)
210 iad1 = addcnet(nodeid)
211 iad2 = addcnet(nodeid + 1) - 1
212 DO iad = iad1, iad2
213 triid = cnt(iad)
214 nall2 = 1
215 DO kk = 1, 3
216 nid2(kk) = ibuf(elem(kk, triid))
217 nall2 = nall2 * itag2(nid2(kk))
218 ENDDO
219 IF (nall2 == 1) THEN
220 ifound = ifound + 1
221 tagels(triid) = i
222 CALL fvnormal(x,nid2(1),nid2(2),nid2(3),0,nex,ney,nez)
223 ss=nsx*nex+nsy*ney+nsz*nez
224 IF (ss<=zero) THEN
225 CALL ancmsg(msgid=634,
226 . msgtype=msgerror,
227 . anmode=aninfo_blind_1,
228 . i1=monvid,
229 . c1=titr,
230 . i2=ixs(nixs,ii))
231 info=1
232 ENDIF
233 ENDIF
234 ENDDO
235 ENDDO
236C
237 IF(ifound == 0) THEN
238 ierror=1
239 IF(ilvout >= 2) WRITE(iout,'(A,I10)')
240 . 'WARNING : CANNOT FIND AIRBAG TRIANGLE FOR BRICK',
241 . ixs(nixs,ii)
242 ENDIF
243C
244 DO k = 1, nod(j)
245 kk = fac(k, j)
246 itag2(ixs(1+kk,ii))=0
247 ENDDO
248
249 ELSE ! NALL=0
250 tfac(2*(j-1)+1,i)=3
251 IF (ntype==2) THEN
252 nela=nela+1
253 ELSEIF (ntype==3) THEN
254 IF(nod6(j)==4) THEN
255 nela=nela+2
256 ELSE
257 nela=nela+1
258 ENDIF
259 ELSEIF (ntype==4) THEN
260 IF(nod5(j)==4) THEN
261 nela=nela+2
262 ELSE
263 nela=nela+1
264 ENDIF
265 ELSEIF (ntype==1) THEN
266 nela=nela+2
267 ENDIF
268 ENDIF
269C
270 ELSEIF (tfac(2*(j-1)+1,i)==-2) THEN
271 IF (nall==1) THEN
272 DO k = 1, nod(j)
273 kk = fac(k, j)
274 itag2(ixs(1+kk,ii))=1
275 ENDDO
276
277 DO k=nel+1,nelt
278 nall2=1
279 DO l=1,3
280 ll=ibuf(elem(l,k))
281 nall2=nall2*itag2(ll)
282 ENDDO
283 IF (nall2==1) THEN
284 IF (tagels(2*k-nel-1) == 0) THEN
285 tagels(2*k-nel-1)=i
286 ELSE
287 tagels(2*k-nel)=i
288 ENDIF
289 ENDIF
290 ENDDO
291
292 DO k = 1, nod(j)
293 kk = fac(k, j)
294 itag2(ixs(1+kk,ii))=0
295 ENDDO
296C
297 ENDIF
298 ENDIF
299 ENDDO ! boucle J=1,NFAC
300 ENDDO ! boucle I=1,NBRIC
301 IF(ierror==1.AND.isplit==0) THEN
302 isplit=1
303 DO k=1,nelt-1
304 IF(tagels(k) /= 0) cycle
305 IF(eltg(k+1) /= eltg(k)) cycle
306C Split quad element along diagonal 13
307 tagels(k+1)=1
308 n1=elem(1,k)
309 n3=elem(2,k+1)
310 elem(3,k)=n3
311 elem(1,k+1)=n1
312 ENDDO
313 DO i=1,nbric
314 nfac=nface(tbric(2,i))
315 DO j=1,nfac
316 IF (tfac(2*(j-1)+1,i)==2) tfac(2*(j-1)+1,i)=0
317 ENDDO
318 ENDDO
319 DO k=1,nelt
320 tagels(k)=0
321 ENDDO
322 GO TO 10
323 ELSEIF(ierror==1.AND.isplit==1) THEN
324 CALL ancmsg(msgid=1048,
325 . msgtype=msgerror,
326 . anmode=aninfo_blind_1,
327 . i1=monvid,c1=titr)
328 ENDIF
329C
330
331
332C
333 IF(ilvout >= 3) THEN
334 WRITE(iout,'(A)')'SOLID ELEMENT'
335 WRITE(iout,'(A,A)')' LOC GLOB TYPE 6*(FLAG FACE,',
336 . 'NEIGHBOUR SOLID ELEMENT)'
337 DO i=1,nbric
338 WRITE(iout,'(2I8,I5,6(I5,I8))')i,tbric(1,i),tbric(2,i),
339 . (tfac(2*(j-1)+1,i),tfac(2*(j-1)+2,i),j=1,6)
340 ENDDO
341 ENDIF
342C
343C Verification of the orientation of totally internal bricks
344C
345 IF (info==0) THEN
346 DO i=1,nb_node
347 itag(i)=0
348 ENDDO
349C
350 DO i=1,nbric
351CA brick pressed against the airbag has internal faces
352 ii=tbric(1,i)
353 ntype=tbric(2,i)
354 nfac=nface(ntype)
355 DO j=1,nfac
356 IF (tfac(2*(j-1)+1,i)/=1) cycle
357 nv=tfac(2*(j-1)+2,i)
358C
359 IF (ntype==2) THEN
360 DO k=1,3
361 kk=fac4(k,j)
362 itag(ixs(1+kk,ii))=1
363 ENDDO
364C Normal to the solid facet
365 n1=ixs(1+fac4(1,j),ii)
366 n2=ixs(1+fac4(2,j),ii)
367 n3=ixs(1+fac4(3,j),ii)
368 n4=0
369 CALL fvnormal(x,n1,n2,n3,n4,nsx,nsy,nsz)
370 ELSEIF (ntype==3) THEN
371 DO k=1,nod6(j)
372 kk=fac6(k,j)
373 itag(ixs(1+kk,ii))=1
374 ENDDO
375C Normal to the solid facet
376 n1=ixs(1+fac6(1,j),ii)
377 n2=ixs(1+fac6(2,j),ii)
378 n3=ixs(1+fac6(3,j),ii)
379 IF(nod6(j)==4) THEN
380 n4=ixs(1+fac6(4,j),ii)
381 ELSE
382 n4=0
383 ENDIF
384 CALL fvnormal(x,n1,n2,n3,n4,nsx,nsy,nsz)
385 ELSEIF (ntype==4) THEN
386 DO k=1,nod5(j)
387 kk=fac5(k,j)
388 itag(ixs(1+kk,ii))=1
389 ENDDO
390C Normal to the solid facet
391 n1=ixs(1+fac5(1,j),ii)
392 n2=ixs(1+fac5(2,j),ii)
393 n3=ixs(1+fac5(3,j),ii)
394 IF(nod5(j)==4) THEN
395 n4=ixs(1+fac5(4,j),ii)
396 ELSE
397 n4=0
398 ENDIF
399 CALL fvnormal(x,n1,n2,n3,n4,nsx,nsy,nsz)
400 ELSEIF (ntype==1) THEN
401 DO k=1,4
402 kk=fac8(k,j)
403 itag(ixs(1+kk,ii))=1
404 ENDDO
405C Normal to the solid facet
406 n1=ixs(1+fac8(1,j),ii)
407 n2=ixs(1+fac8(2,j),ii)
408 n3=ixs(1+fac8(3,j),ii)
409 n4=ixs(1+fac8(4,j),ii)
410 CALL fvnormal(x,n1,n2,n3,n4,nsx,nsy,nsz)
411 ENDIF
412C
413 ntype2=tbric(2,nv)
414 nfac2=nface(ntype2)
415 DO k=1,nfac2
416 IF (ntype2==2) THEN
417 nall=1
418 DO l=1,3
419 ll=fac4(l,k)
420 nall=nall*itag(ixs(1+ll,tbric(1,nv)))
421 ENDDO
422 ELSEIF (ntype2==3) THEN
423 nall=1
424 DO l=1,nod6(k)
425 ll=fac6(l,k)
426 nall=nall*itag(ixs(1+ll,tbric(1,nv)))
427 ENDDO
428 ELSEIF (ntype2==4) THEN
429 nall=1
430 DO l=1,nod5(k)
431 ll=fac5(l,k)
432 nall=nall*itag(ixs(1+ll,tbric(1,nv)))
433 ENDDO
434 ELSEIF (ntype2==1) THEN
435 nall=1
436 DO l=1,4
437 ll=fac8(l,k)
438 nall=nall*itag(ixs(1+ll,tbric(1,nv)))
439 ENDDO
440 ENDIF
441 IF (nall==0) cycle
442C Normal to the neighbor facet
443 IF (ntype2==2) THEN
444 nn1=ixs(1+fac4(1,k),tbric(1,nv))
445 nn2=ixs(1+fac4(2,k),tbric(1,nv))
446 nn3=ixs(1+fac4(3,k),tbric(1,nv))
447 nn4=0
448 CALL fvnormal(x,nn1,nn2,nn3,nn4,nsx2,nsy2,nsz2)
449 ELSEIF (ntype2==3) THEN
450 nn1=ixs(1+fac6(1,k),tbric(1,nv))
451 nn2=ixs(1+fac6(2,k),tbric(1,nv))
452 nn3=ixs(1+fac6(3,k),tbric(1,nv))
453 IF(nod6(k)==4) THEN
454 nn4=ixs(1+fac6(4,k),tbric(1,nv))
455 ELSE
456 nn4=0
457 ENDIF
458 CALL fvnormal(x,nn1,nn2,nn3,nn4,nsx2,nsy2,nsz2)
459 ELSEIF (ntype2==4) THEN
460 nn1=ixs(1+fac5(1,k),tbric(1,nv))
461 nn2=ixs(1+fac5(2,k),tbric(1,nv))
462 nn3=ixs(1+fac5(3,k),tbric(1,nv))
463 IF(nod5(k)==4) THEN
464 nn4=ixs(1+fac5(4,k),tbric(1,nv))
465 ELSE
466 nn4=0
467 ENDIF
468 CALL fvnormal(x,nn1,nn2,nn3,nn4,nsx2,nsy2,nsz2)
469 ELSEIF (ntype2==1) THEN
470 nn1=ixs(1+fac8(1,k),tbric(1,nv))
471 nn2=ixs(1+fac8(2,k),tbric(1,nv))
472 nn3=ixs(1+fac8(3,k),tbric(1,nv))
473 nn4=ixs(1+fac8(4,k),tbric(1,nv))
474 CALL fvnormal(x,nn1,nn2,nn3,nn4,nsx2,nsy2,nsz2)
475 ENDIF
476C
477 ss=nsx*nsx2+nsy*nsy2+nsz*nsz2
478 IF (ss>=zero) THEN
479 CALL ancmsg(msgid=634,
480 . msgtype=msgerror,
481 . anmode=aninfo_blind_1,
482 . i1=monvid,
483 . c1=titr,
484 . i2=ixs(nixs,ii))
485 ENDIF
486 GOTO 100
487 ENDDO
488 100 CONTINUE
489C
490 IF (ntype==2) THEN
491 DO k=1,3
492 kk=fac4(k,j)
493 itag(ixs(1+kk,ii))=0
494 ENDDO
495 ELSEIF (ntype==3) THEN
496 DO k=1,nod6(j)
497 kk=fac6(k,j)
498 itag(ixs(1+kk,ii))=0
499 ENDDO
500 ELSEIF (ntype==4) THEN
501 DO k=1,nod5(j)
502 kk=fac5(k,j)
503 itag(ixs(1+kk,ii))=0
504 ENDDO
505 ELSEIF (ntype==1) THEN
506 DO k=1,4
507 kk=fac8(k,j)
508 itag(ixs(1+kk,ii))=0
509 ENDDO
510 ENDIF
511 ENDDO
512 ENDDO
513 ENDIF
514C
515C Addition of airbag triangles and internal triangles not pressed against a brick
516C
517 DO i=1,nelt
518 IF (tagels(i)==0) nela=nela+1
519 ENDDO
520C
521 IF(nela > 0) THEN
522 WRITE(iout,'(/5X,A,I10/)') 'NUMBER OF AIRBAG TRIANGLES NOT CONNECTED TO A SOLID ELEMENT . .=',nela
523 ENDIF
524C
525C Auxiliary nodes
526C
527 DO i=1,nb_node
528 itag(i)=0
529 ENDDO
530 DO i=1,nbric
531 ii=tbric(1,i)
532 ntype=tbric(2,i)
533 IF (ntype==2) THEN
534 itag(ixs(1+1,ii))=1
535 itag(ixs(1+3,ii))=1
536 itag(ixs(1+6,ii))=1
537 itag(ixs(1+5,ii))=1
538 ELSEIF (ntype==3) THEN
539 itag(ixs(1+1,ii))=1
540 itag(ixs(1+2,ii))=1
541 itag(ixs(1+3,ii))=1
542 itag(ixs(1+5,ii))=1
543 itag(ixs(1+6,ii))=1
544 itag(ixs(1+7,ii))=1
545 ELSEIF (ntype==4) THEN
546 itag(ixs(1+1,ii))=1
547 itag(ixs(1+2,ii))=1
548 itag(ixs(1+3,ii))=1
549 itag(ixs(1+4,ii))=1
550 itag(ixs(1+5,ii))=1
551 ELSEIF (ntype==1) THEN
552 DO j=1,8
553 itag(ixs(1+j,ii))=1
554 ENDDO
555 ENDIF
556 ENDDO
557 nna=0
558 DO i=1,nb_node
559 IF (itag(i)==1) THEN
560 nna=nna+1
561 ENDIF
562 ENDDO
563 t_monvoln%NNA = nna
564 t_monvoln%NTGA = nela
565 ALLOCATE(t_monvoln%IBUFA(nna))
566 IF (nela > 0) THEN
567 ALLOCATE(t_monvoln%ELEMA(3, nela))
568 t_monvoln%ELEMA(:, :) = 0
569 ALLOCATE(t_monvoln%TAGELA(nela))
570 t_monvoln%TAGELA(:) = 0
571 ENDIF
572 ALLOCATE(t_monvoln%BRNA(8, t_monvoln%NBRIC))
573 t_monvoln%BRNA(:, :) = 0
574 IF (nna > 0) THEN
575 ALLOCATE(t_monvoln%NCONA(16, nna))
576 t_monvoln%NCONA(:, :) = 0
577 ENDIF
578
579 nna=0
580 DO i=1,nb_node
581 IF (itag(i)==1) THEN
582 nna=nna+1
583 t_monvoln%IBUFA(nna)=i
584 ENDIF
585 ENDDO
586C
587 IF (ALLOCATED(addcnet)) DEALLOCATE(addcnet)
588 IF (ALLOCATED(adsky)) DEALLOCATE(adsky)
589 IF (ALLOCATED(cnt)) DEALLOCATE(cnt)
590 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
fvnormal
subroutine fvnormal(x, n1, n2, n3, n4, nx, ny, nz)
Definition fvmbag1.F:576
message_mod
Definition message_mod.F:1257
monvol_struct_mod
Definition monvol_struct_mod.F:66
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
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