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

Go to the source code of this file.

Functions/Subroutines

subroutine fvbric3 (ibuf, ibufa, nnt, nbric, nna, tbric, brna, ncona, itab, ilvout, nb_node, ivini, vini, kmesh, v)

Function/Subroutine Documentation

◆ fvbric3()

subroutine fvbric3 ( integer, dimension(*) ibuf,
integer, dimension(nna), intent(in) ibufa,
integer nnt,
integer nbric,
integer nna,
integer, dimension(2, nbric), intent(in) tbric,
integer, dimension(8,*) brna,
integer, dimension(16,*) ncona,
integer, dimension(*) itab,
integer ilvout,
integer nb_node,
integer ivini,
vini,
integer kmesh,
v )

Definition at line 28 of file fvbric3.F.

31C-----------------------------------------------
32C I m p l i c i t T y p e s
33C-----------------------------------------------
34#include "implicit_f.inc"
35C-----------------------------------------------
36C C o m m o n B l o c k s
37C-----------------------------------------------
38#include "units_c.inc"
39C-----------------------------------------------
40C D u m m y A r g u m e n t s
41C-----------------------------------------------
42 INTEGER IBUF(*), NNT, NBRIC, NNA, ITAB(*), ILVOUT,
43 . BRNA(8,*), NCONA(16,*), NB_NODE, IVINI, KMESH
44 INTEGER, DIMENSION(NNA), INTENT(IN) :: IBUFA
45 INTEGER, DIMENSION(2, NBRIC), INTENT(IN) :: TBRIC
46 my_real vini(3), v(3,*)
47C-----------------------------------------------
48C L o c a l V a r i a b l e s
49C-----------------------------------------------
50 INTEGER I, J, K, L, N, II, JJ, KK, NN, NTYPE, IMAX
51 INTEGER IBRCO(31,NNA), ITAG(NNA), JTAG(NB_NODE)
52 INTEGER TAG(8), REDIR(8), NNAI
53 my_real vmax, vmin, vel
54
55 DATA tag /1,1,2,2,2,3,3,4/
56C
57 DO i=1,nna
58 DO j=1,31
59 ibrco(j,i)=0
60 ENDDO
61C
62 DO j=1,16
63 ncona(j,i)=0
64 ENDDO
65 ENDDO
66C
67C Solides connectes au noeud N
68C
69 DO i=1,nbric
70 ntype=tbric(2,i)
71 IF(ntype==2) THEN
72 redir(1)=1
73 redir(2)=3
74 redir(3)=5
75 redir(4)=6
76 DO j=1,4
77 n=brna(redir(j),i)
78 jj=ibrco(1,n)
79 jj=jj+1
80 IF(jj>30) cycle
81 ibrco(1,n)=jj
82 ibrco(jj+1,n)=i
83 ENDDO
84 ELSEIF(ntype==3) THEN
85 redir(1)=1
86 redir(2)=2
87 redir(3)=3
88 redir(4)=5
89 redir(5)=6
90 redir(6)=7
91 DO j=1,6
92 n=brna(redir(j),i)
93 jj=ibrco(1,n)
94 jj=jj+1
95 IF(jj>12) cycle
96 ibrco(1,n)=jj
97 ibrco(jj+1,n)=i
98 ENDDO
99 ELSEIF(ntype==4) THEN
100 DO j=1,5
101 n=brna(j,i)
102 jj=ibrco(1,n)
103 jj=jj+1
104 IF(jj>12) cycle
105 ibrco(1,n)=jj
106 ibrco(jj+1,n)=i
107 ENDDO
108 ELSEIF(ntype==1) THEN
109 DO j=1,8
110 n=brna(j,i)
111 jj=ibrco(1,n)
112 jj=jj+1
113 IF(jj>12) cycle
114 ibrco(1,n)=jj
115 ibrco(jj+1,n)=i
116 ENDDO
117 ENDIF
118 ENDDO
119C
120 IF(ilvout >=3 ) THEN
121 WRITE(iout,2000)
122 DO i=1,nna
123 n=itab(ibufa(i))
124 k=ibrco(1,i)
125 kk=min(k,12)
126 WRITE(iout,'(15I10)')i,n,k,(ibrco(l+1,i),l=1,kk)
127 ENDDO
128 ENDIF
129C
130C Noeud solide appartenant a des coques airbag ou internes => lagrangien
131C
132 DO i=1,nb_node
133 jtag(i)=0
134 ENDDO
135 DO i=1,nnt
136 jtag(ibuf(i))=1
137 ENDDO
138 DO i=1,nna
139 j=ibufa(i)
140 IF(jtag(j)==1) ncona(2,i)=1
141 ENDDO
142C
143C Noeuds voisins pour calcul de la vitesse de grille
144C
145 nnai=0
146 DO i=1,nna
147 IF(ncona(2,i)/=0) cycle
148 nnai=nnai+1
149 ii=ibrco(1,i)
150 DO n=1,nna
151 itag(n)=0
152 ENDDO
153 DO j=1,ii
154 jj=ibrco(j+1,i)
155 ntype=tbric(2,jj)
156 IF(ntype==2) THEN
157 redir(1)=1
158 redir(2)=3
159 redir(3)=5
160 redir(4)=6
161 DO k=1,4
162 kk=brna(redir(k),jj)
163 itag(kk)=itag(kk)+1
164 ENDDO
165 ELSEIF(ntype==3) THEN
166 redir(1)=1
167 redir(2)=2
168 redir(3)=3
169 redir(4)=5
170 redir(5)=6
171 redir(6)=7
172 DO k=1,6
173 kk=brna(redir(k),jj)
174 itag(kk)=itag(kk)+1
175 ENDDO
176 ELSEIF(ntype==4) THEN
177 DO k=1,5
178 kk=brna(k,jj)
179 itag(kk)=itag(kk)+1
180 ENDDO
181 ELSEIF(ntype==1) THEN
182 DO k=1,8
183 kk=brna(k,jj)
184 itag(kk)=itag(kk)+1
185 ENDDO
186 ENDIF
187 ENDDO
188C
189 IF(ii > 8) THEN
190 imax=4
191 ELSE
192 imax=tag(ii)
193 ENDIF
194 DO n=1,nna
195 IF(n==i) cycle
196 IF(itag(n)>=imax) THEN
197C Le noeud N appartient a au moins IMAX solides voisins
198 nn=ncona(1,i)
199 nn=nn+1
200 IF(nn>14) GO TO 100
201 ncona(1,i)=nn
202 ncona(nn+2,i)=n
203 ENDIF
204 ENDDO
205 100 CONTINUE
206 ENDDO
207C
208C Initial velocity of internal gas nodes
209 ivini=0
210 IF(nnai > 0) THEN
211 vmax=zero
212 vmin=ep30
213 DO i=1,nnt
214 j=ibuf(i)
215 vel=v(1,j)*v(1,j)+v(2,j)*v(2,j)+v(3,j)*v(3,j)
216 IF(vel > vmax) vmax=vel
217 IF(vel < vmin) vmin=vel
218 ENDDO
219 IF(vmin == vmax) THEN
220 IF(vmin > zero) THEN
221 ivini=1
222 j=ibuf(1)
223 vini(1)=v(1,j)
224 vini(2)=v(2,j)
225 vini(3)=v(3,j)
226 ELSE
227 ivini=0
228 vini(1)=zero
229 vini(2)=zero
230 vini(3)=zero
231 ENDIF
232 ELSE
233 ivini=1
234 vini(1)=zero
235 vini(2)=zero
236 vini(3)=zero
237 WRITE(iout,'(/A/)') 'fvmbag - warning non uniform initial velocity : internal gas node velocities are not initialized'
238 ENDIF
239 ENDIF
240C
241C Set to zero initial velocity of internal brick nodes (kmesh=1)
242.AND..AND. IF(NNAI > 0 IVINI == 1 KMESH == 1) THEN
243 DO I=1,NNA
244 IF(NCONA(2,I)/=0) CYCLE
245 J=IBUFA(I)
246 V(1,J)=ZERO
247 V(2,J)=ZERO
248 V(3,J)=ZERO
249 ENDDO
250 ENDIF
251C
252 WRITE(IOUT,3000) NBRIC,NNA,NNAI
253 IF(ILVOUT >= 3) THEN
254 WRITE(IOUT,1000)
255 DO I=1,NNA
256 IF(NCONA(2,I)/=0) CYCLE
257C Noeud interne
258 N=ITAB(IBUFA(I))
259 K=NCONA(1,I)
260 WRITE(IOUT,'(15i10)') N,(ITAB(IBUFA(NCONA(L+2,I))),L=1,K)
261 ENDDO
262 ENDIF
263C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----0----+----1----+----2----+----3--
264 1000 FORMAT(
265 ./5X,'fvmbag - list of connected nodes - solid grid velocity '
266 ./5X,'-----------------------------------------------------------'
267 ./5X,' node',8X,'n1',8X,'n2',8X,'n3',8X,'n4',8X,'n5',8X,'n6',8X,
268 .'n7',8X,'n8',8X,'n9',7X,'n10',7X,'n11',7X,'n12',7X,'n13',7X,'n14')
269C
270 2000 FORMAT(
271 ./5X,'fvmbag - list of connected solid '
272 ./5X,'-----------------------------------------------------------'
273 ./6X,'node loc-glob nb solids',8X,'n1',8X,'n2',8X,'n3',8X,'n4',8X,
274 .'n5',8X,'n6',8X,'n7',8X,'n8',8X,'n9',7X,'n10',7X,'n11',7X,'n12')
275C
276 3000 FORMAT(/5X,'fvmbag : additional brick group ',
277 . /5X,'------------------------------- ',
278 . /5X,'number of additional bricks . . . . . .=',I10,
279 . /5X,'number of additional brick nodes. . . .=',I10,
280 . /5X,'number of internal brick nodes. . . . .=',I10)
281 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20