OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvbric3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| fvbric3 ../starter/source/airbag/fvbric3.F
25!||--- called by ------------------------------------------------------
26!|| init_monvol ../starter/source/airbag/init_monvol.F
27!||====================================================================
28 SUBROUTINE fvbric3(IBUF, IBUFA, NNT, NBRIC, NNA,
29 . TBRIC, BRNA, NCONA, ITAB,
30 . ILVOUT,NB_NODE,IVINI, VINI, KMESH, V )
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 IF(nnai > 0 .AND. ivini == 1 .AND. 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
282 END
283
my_real
#define my_real
Definition cppsort.cpp:32
fvbric3
subroutine fvbric3(ibuf, ibufa, nnt, nbric, nna, tbric, brna, ncona, itab, ilvout, nb_node, ivini, vini, kmesh, v)
Definition fvbric3.F:31
min
#define min(a, b)
Definition macros.h:20