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