OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvmbag1.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine aleno (nn, surf_nodes, nnb, itabinv, tage, tagvent, tagnodbr, t_monvoln)
subroutine fvverif (nela, elema, x, monvid, vx3, vy3, vz3, vx1, vy1, vz1, xb0, yb0, zb0, lx, ly, lz, ibuf, ibufa, tagela, titr)
subroutine fvnodi (nn, surf_nodes, nnb, itabinv, t_monvoln)
subroutine fvnodbr (ibufa, nna, nnfv, ifv, nb_node)
subroutine fvnormal (x, n1, n2, n3, n4, nx, ny, nz)

Function/Subroutine Documentation

◆ aleno()

subroutine aleno ( integer nn,
integer, dimension(nn,4) surf_nodes,
integer nnb,
integer, dimension(*) itabinv,
integer, dimension(*) tage,
integer, dimension(numnod) tagvent,
integer, dimension(numnod) tagnodbr,
type(monvol_struct_), intent(inout) t_monvoln )

Definition at line 30 of file fvmbag1.F.

32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE monvol_struct_mod
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com04_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER NN, NNB,
48 . ITABINV(*), TAGE(*), TAGVENT(NUMNOD),
49 . TAGNODBR(NUMNOD),SURF_NODES(NN,4)
50 TYPE(MONVOL_STRUCT_), INTENT(INOUT) :: T_MONVOLN
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER ITAG(NUMNOD),IAD1,I,I1,I2,I3,I4,J,K,KK,NA,NB,NC,NC2,IADC, IADFIN, JAD1, NALL, NODESURF(4*NN)
55 INTEGER IADCH(NUMNOD),CHAIN(2,4*NN),NEXT(4*NN),IP2(0:3),INVP2(15)
56C-----------------------------------------------
57C
58C removing duplicated
59C
60 DO i=1,numnod
61 iadch(i)=0
62 itag(i)=0
63 tagvent(i)=0
64 ENDDO
65
66! temporary nodal surface array
67
68 iad1 = 1
69 DO i=1,nn
70 DO k=1,4
71 nodesurf(iad1) = surf_nodes(i,k)
72 iad1=iad1+1
73 ENDDO
74 ENDDO
75
76C construction liste chaine connectivites inverses (noeuds/elts)
77
78 iad1=1
79 iadfin = 1
80 DO i=1,nn
81 tage(i)=0
82 DO k = 0,3
83 j=nodesurf(iad1+k)
84 IF(k == 3) THEN
85 IF(j == nodesurf(iad1+k-1)) j=0
86 END IF
87 IF(j == 0) cycle
88 iadc = iadch(j)
89 IF(iadc == 0)THEN
90 iadch(j) = iadfin
91 ELSE
92 DO WHILE (next(iadc) /= 0)
93 iadc = next(iadc)
94 ENDDO
95 next(iadc) = iadfin
96 ENDIF
97 chain(1,iadfin)=iad1
98 chain(2,iadfin)=i
99 next(iadfin) =0
100 iadfin = iadfin+1
101 ENDDO
102 iad1=iad1 + 4
103 ENDDO
104C
105 ip2(0) = 1
106 ip2(1) = 2
107 ip2(2) = 4
108 ip2(3) = 8
109 invp2(7)=4
110 invp2(11)=3
111 invp2(13)=2
112 invp2(14)=1
113C
114
115C Listing duplicated
116
117 iad1=1
118 DO i=1,nn
119 na=0
120 nall=1
121C tag noeuds 1er elt
122 DO k = 0,3
123 j = nodesurf(iad1+k)
124 IF(k == 3) THEN
125 IF(j == nodesurf(iad1+k-1)) j=0
126 END IF
127 IF(j /= 0) THEN
128 itag(j)=100+ip2(k)
129 na = na+1
130 nall=nall*tagnodbr(j)
131 ENDIF
132 ENDDO
133 IF(nall == 1) GO TO 10
134C
135 DO k = 0,3
136 j=nodesurf(iad1+k)
137 IF(k == 3) THEN
138 IF(j == nodesurf(iad1+k-1)) j=0
139 END IF
140 IF(j == 0) cycle
141 iadc = iadch(j)
142C boucle sur les elts connecte au noeud k+1 du 1er elt
143 DO WHILE (iadc /= 0)
144 nc=0
145 nb=0
146 jad1=chain(1,iadc)
147 IF(jad1 /= iad1) THEN
148C Denombrement des tags des noeuds du 2eme elt
149 DO kk = 0,3
150 j = nodesurf(jad1+kk)
151 IF(kk == 3) THEN
152 IF(j == nodesurf(jad1+kk-1)) j=0
153 END IF
154 IF(j /= 0)THEN
155 nc = nc+itag(j)
156 nb = nb+1
157 ENDIF
158 ENDDO
159 nc2 = nc
160 nc = nc / 100
161 nc2 = nc2 - 100*nc
162C test pour 2 triangles ou 2 quadrangles avec ts les noeuds communs
163 IF(nc == na .and. na == nb)THEN
164 tage(i)=5
165C test pour 2 elts (2 quadrangles ou 1 triangle et 1 quadrangle) avec 3 noeuds communs
166 ELSEIF(nc == 3)THEN
167 IF(na == 4)THEN
168C le 1er est un quadrangle
169 tage(i)=invp2(nc2) ! tag numero noeud libre
170 ELSE
171C le 1er est un triangle
172 tage(i)=5
173 ENDIF
174 ENDIF
175 ENDIF
176 iadc = next(iadc)
177 ENDDO
178 ENDDO
179 10 CONTINUE
180 DO k = 0,3
181 j = nodesurf(iad1+k)
182 IF(k == 3) THEN
183 IF(j == nodesurf(iad1+k-1)) j=0
184 END IF
185 IF(j /= 0) itag(j)=0
186 ENDDO
187 iad1=iad1 + 4
188 ENDDO
189
190 nc = 0
191 nc2 = 0
192 DO i=1,nn
193 IF(tage(i) == 5)THEN
194 nc = nc + 1
195 ELSEIF(tage(i) /= 0)THEN
196 nc2 = nc2 + 1
197 END IF
198 END DO
199
200c fin elimination des elements doubles
201
202 DO i=1,numnod
203 itag(i)=0
204 ENDDO
205 iad1=1
206 DO i=1,nn
207 i1=nodesurf(iad1)
208 i2=nodesurf(iad1+1)
209 i3=nodesurf(iad1+2)
210 i4=nodesurf(iad1+3)
211 IF(tage(i) == 0)THEN
212 itag(i1)=1
213 itag(i2)=1
214 itag(i3)=1
215 IF (i4 /= 0) itag(i4)=1
216 ELSEIF(tage(i) == 1)THEN
217 itag(i1)=1
218 itag(i2)=1
219 itag(i4)=1
220 tagvent(i3)=1
221 ELSEIF(tage(i) == 2)THEN
222 itag(i2)=1
223 itag(i3)=1
224 itag(i1)=1
225 IF (i4 /= 0) tagvent(i4)=1
226 ELSEIF(tage(i) == 3)THEN
227 itag(i3)=1
228 itag(i4)=1
229 itag(i2)=1
230 tagvent(i1)=1
231 ELSEIF(tage(i) == 4)THEN
232 itag(i4)=1
233 itag(i1)=1
234 itag(i3)=1
235 tagvent(i2)=1
236 ELSEIF(tage(i) == 5)THEN
237 tagvent(i1)=1
238 tagvent(i2)=1
239 tagvent(i3)=1
240 IF (i4 /= 0) tagvent(i4)=1
241 ENDIF
242 iad1=iad1 + 4
243 ENDDO
244 nnb=0
245 DO i=1,numnod
246 IF (itag(i)==1) THEN
247 nnb=nnb+1
248 itabinv(i)=nnb
249 ENDIF
250 END DO
251 t_monvoln%NNS = nnb
252 ALLOCATE(t_monvoln%NODES(nnb))
253 nnb = 0
254 DO i=1,numnod
255 IF (itag(i)==1) THEN
256 nnb=nnb+1
257 t_monvoln%NODES(nnb)=i
258 ENDIF
259 END DO
260C
261 RETURN
monvol_struct_mod
Definition monvol_struct_mod.F:66

◆ fvnodbr()

subroutine fvnodbr ( integer, dimension(*) ibufa,
integer nna,
integer nnfv,
integer ifv,
integer nb_node )

Definition at line 529 of file fvmbag1.F.

530C-----------------------------------------------
531C M o d u l e s
532C-----------------------------------------------
533 USE fvbag_mod
534C-----------------------------------------------
535C I m p l i c i t T y p e s
536C-----------------------------------------------
537#include "implicit_f.inc"
538C-----------------------------------------------
539C D u m m y A r g u m e n t s
540C-----------------------------------------------
541 INTEGER IBUFA(*), NNA, NNFV, IFV, NB_NODE
542C-----------------------------------------------
543C L o c a l V a r i a b l e s
544C-----------------------------------------------
545 INTEGER I, N, ITAB(NB_NODE)
546C
547C Save local number of a brick node in IFVNOD(3)
548C
549 DO i=1,nb_node
550 itab(i)=0
551 ENDDO
552C
553 DO i=1,nna
554 n=ibufa(i)
555 itab(n)=i
556 ENDDO
557C
558 DO i=1,nnfv
559 IF(fvdata(ifv)%IFVNOD(1,i)/=2) cycle
560 n=fvdata(ifv)%IFVNOD(2,i)
561 fvdata(ifv)%IFVNOD(3,i)=itab(n)
562 ENDDO
563C
564 RETURN
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvdata
type(fvbag_data), dimension(:), allocatable fvdata
Definition fvbag_mod.F:128

◆ fvnodi()

subroutine fvnodi ( integer, intent(in) nn,
integer, dimension(nn, 4), intent(in) surf_nodes,
integer, intent(out) nnb,
integer, dimension(numnod), intent(inout) itabinv,
type(monvol_struct_), intent(inout) t_monvoln )

Definition at line 428 of file fvmbag1.F.

429C-----------------------------------------------
430C M o d u l e s
431C-----------------------------------------------
432 USE monvol_struct_mod
433C-----------------------------------------------
434C I m p l i c i t T y p e s
435C-----------------------------------------------
436#include "implicit_f.inc"
437C-----------------------------------------------
438C C o m m o n B l o c k s
439C-----------------------------------------------
440#include "com04_c.inc"
441C-----------------------------------------------
442C D u m m y A r g u m e n t s
443C-----------------------------------------------
444 INTEGER, INTENT(IN) :: NN
445 INTEGER, DIMENSION(NN, 4), INTENT(IN) :: SURF_NODES
446 INTEGER, INTENT(OUT) :: NNB
447 INTEGER, DIMENSION(NUMNOD), INTENT(INOUT) :: ITABINV
448 TYPE(MONVOL_STRUCT_), INTENT(INOUT) :: T_MONVOLN
449C-----------------------------------------------
450C L o c a l V a r i a b l e s
451C-----------------------------------------------
452 INTEGER I, I1, I2, I3, I4, NNS
453 INTEGER, DIMENSION(:), ALLOCATABLE :: BUFNODE
454 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG, ITAG_SURFEXT, ITABINV_SURFEXT
455 INTEGER(8) :: VEC_PTR_SURFINT
456
457 ALLOCATE(itag(numnod), itag_surfext(numnod), itabinv_surfext(numnod))
458
459 DO i = 1, numnod
460 itag(i) = 0
461 itag_surfext(i) = 0
462 itabinv_surfext(i) = 0
463 ENDDO
464
465 nns = t_monvoln%NNS
466 ALLOCATE(bufnode(nns))
467 DO i = 1, nns
468 bufnode(i) = t_monvoln%NODES(i)
469! FLAG NODES OF EXTERNAL SURFACE
470 itag_surfext(t_monvoln%NODES(i)) = 1
471! KEEP INDEX IN ITABINV_SURFEXT TAB
472 itabinv_surfext(t_monvoln%NODES(i)) = i
473 ENDDO
474
475! FLAG NODES OF INTERNAL SURFACE
476 DO i=1,nn
477 i1=surf_nodes(i,1)
478 i2=surf_nodes(i,2)
479 i3=surf_nodes(i,3)
480 i4=surf_nodes(i,4)
481 itag(i1)=1
482 itag(i2)=1
483 itag(i3)=1
484 IF (i4 /= 0) itag(i4)=1
485 ENDDO
486
487! COUNT AND BUILD INDIRECTION TAB OF INTERNAL SURFACE NODES
488! THAT DO NOT ALREADY APPEAR IN EXTERNAL SURFACE
489 CALL intvector_create(vec_ptr_surfint)
490 nnb = 0
491 DO i = 1, numnod
492 IF (itag(i) == 1) THEN
493 IF (itag_surfext(i) /= 1) THEN
494! Node that does not already appear in external surface
495 nnb = nnb + 1
496 itabinv(i) = nnb + nns
497 CALL intvector_push_back(vec_ptr_surfint, i)
498 ELSE
499 itabinv(i) = itabinv_surfext(i)
500 ENDIF
501 ENDIF
502 END DO
503
504 DEALLOCATE(t_monvoln%NODES)
505 ALLOCATE(t_monvoln%NODES(nnb + nns))
506 DO i = 1, nns
507 t_monvoln%NODES(i) = bufnode(i)
508 ENDDO
509 t_monvoln%NNI = nnb
510
511 IF(nnb>0)CALL intvector_copy_to(vec_ptr_surfint, t_monvoln%NODES(nns + 1))
512
513 CALL intvector_delete(vec_ptr_surfint)
514 DEALLOCATE(bufnode)
515 DEALLOCATE(itag)
516 DEALLOCATE(itag_surfext)
517 DEALLOCATE(itabinv_surfext)
518C
519 RETURN

◆ fvnormal()

subroutine fvnormal ( x,
integer n1,
integer n2,
integer n3,
integer n4,
nx,
ny,
nz )

Definition at line 575 of file fvmbag1.F.

576C-----------------------------------------------
577C I m p l i c i t T y p e s
578C-----------------------------------------------
579#include "implicit_f.inc"
580C-----------------------------------------------
581C D u m m y A r g u m e n t s
582C-----------------------------------------------
583 INTEGER N1, N2, N3, N4
584 my_real x(3,*), nx, ny, nz
585C-----------------------------------------------
586C L o c a l V a r i a b l e s
587C-----------------------------------------------
588 my_real
589 . x1, y1, z1, x2, y2, z2, x3, y3, z3, x12, y12, z12,
590 . x13, y13, z13, x4, y4, z4, x24, y24, z24
591C-----------------------------------------------------------------------
592C Compute normal vector for a triangle and a quad
593C-----------------------------------------------------------------------
594 IF(n4==0) THEN
595 x1=x(1,n1)
596 y1=x(2,n1)
597 z1=x(3,n1)
598 x2=x(1,n2)
599 y2=x(2,n2)
600 z2=x(3,n2)
601 x3=x(1,n3)
602 y3=x(2,n3)
603 z3=x(3,n3)
604 x12=x2-x1
605 y12=y2-y1
606 z12=z2-z1
607 x13=x3-x1
608 y13=y3-y1
609 z13=z3-z1
610 nx=y12*z13-z12*y13
611 ny=z12*x13-x12*z13
612 nz=x12*y13-y12*x13
613 ELSE
614 x1=x(1,n1)
615 y1=x(2,n1)
616 z1=x(3,n1)
617 x2=x(1,n2)
618 y2=x(2,n2)
619 z2=x(3,n2)
620 x3=x(1,n3)
621 y3=x(2,n3)
622 z3=x(3,n3)
623 x4=x(1,n4)
624 y4=x(2,n4)
625 z4=x(3,n4)
626 x13=x3-x1
627 y13=y3-y1
628 z13=z3-z1
629 x24=x4-x2
630 y24=y4-y2
631 z24=z4-z2
632 nx=y13*z24-z13*y24
633 ny=z13*x24-x13*z24
634 nz=x13*y24-y13*x24
635 ENDIF
636 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ fvverif()

subroutine fvverif ( integer, intent(in) nela,
integer, dimension(3, nela), intent(in) elema,
x,
integer, intent(in) monvid,
vx3,
vy3,
vz3,
vx1,
vy1,
vz1,
xb0,
yb0,
zb0,
intent(inout) lx,
intent(inout) ly,
intent(inout) lz,
integer, dimension(*), intent(in) ibuf,
integer, dimension(*), intent(in) ibufa,
integer, dimension(*), intent(in) tagela,
character(len=nchartitle), intent(in) titr )

Definition at line 273 of file fvmbag1.F.

278 USE message_mod
279 USE names_and_titles_mod , ONLY : nchartitle
280C-----------------------------------------------
281C I m p l i c i t T y p e s
282C-----------------------------------------------
283#include "implicit_f.inc"
284C-----------------------------------------------
285C C o m m o n B l o c k s
286C-----------------------------------------------
287#include "com04_c.inc"
288C-----------------------------------------------
289C D u m m y A r g u m e n t s
290C-----------------------------------------------
291 INTEGER, INTENT(IN) :: NELA, MONVID
292 INTEGER, DIMENSION(3, NELA), INTENT(IN) :: ELEMA
293 INTEGER, INTENT(IN) :: IBUF(*), IBUFA(*), TAGELA(*)
294 my_real, INTENT(INOUT) :: lx, ly, lz
295 CHARACTER(LEN=nchartitle), INTENT(IN) :: TITR
296 my_real x(3,numnod), vx3, vy3, vz3, vx1, vy1, vz1, xb0, yb0, zb0
297C-----------------------------------------------
298C L o c a l V a r i a b l e s
299C-----------------------------------------------
300 INTEGER I, ITAG(NUMNOD), I1, I2, I3
301 my_real
302 . norm, ss, vx2, vy2, vz2, lxmax, lymax, xx, yy, zz, xl, yl,
303 . lzmax, zl, lx_old, ly_old, lz_old
304C-----------------------------------------------
305C S o u r c e L i n e s
306C-----------------------------------------------
307 norm=sqrt(vx3**2+vy3**2+vz3**2)
308 IF (norm==zero) THEN
309 CALL ancmsg(msgid=630,
310 . msgtype=msgerror,
311 . anmode=aninfo_blind_1,
312 . i1=monvid,
313 . c1=titr)
314 RETURN
315 ENDIF
316 vx3=vx3/norm
317 vy3=vy3/norm
318 vz3=vz3/norm
319 ss=vx3*vx1+vy3*vy1+vz3*vz1
320 vx1=vx1-ss*vx3
321 vy1=vy1-ss*vy3
322 vz1=vz1-ss*vz3
323 norm=sqrt(vx1**2+vy1**2+vz1**2)
324 IF (norm==zero) THEN
325 CALL ancmsg(msgid=630,
326 . msgtype=msgerror,
327 . anmode=aninfo_blind_1,
328 . i1=monvid,
329 . c1=titr)
330 RETURN
331 ENDIF
332 vx1=vx1/norm
333 vy1=vy1/norm
334 vz1=vz1/norm
335 vx2=vy3*vz1-vz3*vy1
336 vy2=vz3*vx1-vx3*vz1
337 vz2=vx3*vy1-vy3*vx1
338C Limites de l'airbag dans les directions de decoupage
339 DO i=1,numnod
340 itag(i)=0
341 ENDDO
342 DO i=1,nela
343 i1=elema(1,i)
344 i2=elema(2,i)
345 i3=elema(3,i)
346 IF (tagela(i)>0) THEN
347 i1=ibuf(i1)
348 i2=ibuf(i2)
349 i3=ibuf(i3)
350 ELSE
351 i1=ibufa(i1)
352 i2=ibufa(i2)
353 i3=ibufa(i3)
354 ENDIF
355 itag(i1)=1
356 itag(i2)=1
357 itag(i3)=1
358 ENDDO
359C
360 lxmax=zero
361 lymax=zero
362 lzmax=zero
363 DO i=1,numnod
364 IF (itag(i)==1) THEN
365 xx=x(1,i)
366 yy=x(2,i)
367 zz=x(3,i)
368C
369 xl=(xx-xb0)*vx1+(yy-yb0)*vy1+(zz-zb0)*vz1
370 yl=(xx-xb0)*vx2+(yy-yb0)*vy2+(zz-zb0)*vz2
371 zl=(xx-xb0)*vx3+(yy-yb0)*vy3+(zz-zb0)*vz3
372 lxmax=max(lxmax,abs(xl))
373 lymax=max(lymax,abs(yl))
374 lzmax=max(lzmax,abs(zl))
375 ENDIF
376 ENDDO
377C
378 IF (lxmax>lx) THEN
379 lx_old=lx
380 lx=lxmax*onep01
381 CALL ancmsg(msgid=631,
382 . msgtype=msgwarning,
383 . anmode=aninfo_blind_1,
384 . i1=monvid,
385 . c1=titr,
386 . r1=lx_old,
387 . r3=lx,
388 . r2=lxmax,
389 . i2=1)
390 ENDIF
391 IF (lymax>ly) THEN
392 ly_old=ly
393 ly=lymax*onep01
394 CALL ancmsg(msgid=631,
395 . msgtype=msgwarning,
396 . anmode=aninfo_blind_1,
397 . i1=monvid,
398 . c1=titr,
399 . r3=ly,
400 . r1=ly_old,
401 . r2=lymax,
402 . i2=2)
403 ENDIF
404 IF (lzmax>lz) THEN
405 lz_old=lz
406 lz=lzmax*onep01
407 CALL ancmsg(msgid=631,
408 . msgtype=msgwarning,
409 . anmode=aninfo_blind_1,
410 . i1=monvid,
411 . c1=titr,
412 . r3=lz,
413 . r1=lz_old,
414 . r2=lzmax,
415 . i2=3)
416 ENDIF
417C
418 RETURN
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
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