OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvbric2.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!|| fvbric2_mod ../starter/source/airbag/fvbric2.F
25!||--- called by ------------------------------------------------------
26!|| init_monvol ../starter/source/airbag/init_monvol.F
27!||====================================================================
29 CONTAINS
30!||====================================================================
31!|| fvbric2 ../starter/source/airbag/fvbric2.F
32!||--- called by ------------------------------------------------------
33!|| init_monvol ../starter/source/airbag/init_monvol.F
34!||====================================================================
35 SUBROUTINE fvbric2(ELEM , IXS , NEL , NBRIC,
36 . TBRIC , TFAC, TAGELS , NELA ,
37 . IBUFA , NNA , ELEMA ,
38 . TAGELA, BRNA, NB_NODE)
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER ELEM(3,*), IXS(NIXS,*), NEL, NBRIC,NELA, NNA, ELEMA(3,*), TAGELA(*), BRNA(8,*), NB_NODE
47 INTEGER, DIMENSION(NNA), INTENT(IN) :: IBUFA
48 INTEGER, DIMENSION(NEL), INTENT(IN) :: TAGELS
49 INTEGER, DIMENSION(2, NBRIC), INTENT(IN) :: TBRIC
50 INTEGER, DIMENSION(12, NBRIC), INTENT(IN) :: TFAC
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER I, II, ITABINV(NB_NODE), NFAC, J, KK, JJ
55 INTEGER FAC4(3,4), FAC8(4,6), FAC6(4,5), NOD6(5)
56 INTEGER FAC5(4,5), NOD5(5), NFACE(4), NTYPE
57 DATA fac4 /1,5,3,
58 . 3,5,6,
59 . 6,5,1,
60 . 1,3,6/
61 DATA fac8 /1,4,3,2,
62 . 5,6,7,8,
63 . 1,2,6,5,
64 . 2,3,7,6,
65 . 3,4,8,7,
66 . 4,1,5,8/
67 DATA fac6 /1,3,2,0,
68 . 5,6,7,0,
69 . 1,2,6,5,
70 . 2,3,7,6,
71 . 3,4,8,7/
72 DATA nod6 /3,3,4,4,4/
73 DATA fac5 /2,1,5,0,
74 . 3,2,5,0,
75 . 3,5,4,0,
76 . 1,4,5,0,
77 . 1,4,3,2/
78 DATA nod5 /3,3,3,3,4/
79 DATA nface/6,4,5,5/
80C
81 nela=0
82 DO i=1,nel
83 IF (tagels(i)==0) THEN
84 nela=nela+1
85 tagela(nela)=i
86 elema(1,nela)=elem(1,i)
87 elema(2,nela)=elem(2,i)
88 elema(3,nela)=elem(3,i)
89 ENDIF
90 ENDDO
91 DO i=1,nna
92 ii=ibufa(i)
93 itabinv(ii)=i
94 ENDDO
95C
96 DO i=1,nbric
97 ii=tbric(1,i)
98 ntype=tbric(2,i)
99 nfac=nface(ntype)
100 DO j=1,nfac
101 IF (tfac(2*(j-1)+1,i)==3) THEN
102C La facette de solide est libre a l'interieur de l'airbag
103 IF (ntype==2) THEN
104 nela=nela+1
105 kk=fac4(1,j)
106 kk=itabinv(ixs(1+kk,ii))
107 elema(1,nela)=kk
108 kk=fac4(2,j)
109 kk=itabinv(ixs(1+kk,ii))
110 elema(3,nela)=kk
111 kk=fac4(3,j)
112 kk=itabinv(ixs(1+kk,ii))
113 elema(2,nela)=kk
114 tagela(nela)=-i
115 ELSEIF (ntype==3) THEN
116 nela=nela+1
117 kk=fac6(1,j)
118 kk=itabinv(ixs(1+kk,ii))
119 elema(1,nela)=kk
120 kk=fac6(2,j)
121 kk=itabinv(ixs(1+kk,ii))
122 elema(3,nela)=kk
123 kk=fac6(3,j)
124 kk=itabinv(ixs(1+kk,ii))
125 elema(2,nela)=kk
126 tagela(nela)=-i
127C
128 IF(nod6(j)==4) THEN
129 nela=nela+1
130 kk=fac6(1,j)
131 kk=itabinv(ixs(1+kk,ii))
132 elema(1,nela)=kk
133 kk=fac6(3,j)
134 kk=itabinv(ixs(1+kk,ii))
135 elema(3,nela)=kk
136 kk=fac6(4,j)
137 kk=itabinv(ixs(1+kk,ii))
138 elema(2,nela)=kk
139 tagela(nela)=-i
140 ENDIF
141 ELSEIF (ntype==4) THEN
142 nela=nela+1
143 kk=fac5(1,j)
144 kk=itabinv(ixs(1+kk,ii))
145 elema(1,nela)=kk
146 kk=fac5(2,j)
147 kk=itabinv(ixs(1+kk,ii))
148 elema(3,nela)=kk
149 kk=fac5(3,j)
150 kk=itabinv(ixs(1+kk,ii))
151 elema(2,nela)=kk
152 tagela(nela)=-i
153C
154 IF(nod5(j)==4) THEN
155 nela=nela+1
156 kk=fac5(1,j)
157 kk=itabinv(ixs(1+kk,ii))
158 elema(1,nela)=kk
159 kk=fac5(3,j)
160 kk=itabinv(ixs(1+kk,ii))
161 elema(3,nela)=kk
162 kk=fac5(4,j)
163 kk=itabinv(ixs(1+kk,ii))
164 elema(2,nela)=kk
165 tagela(nela)=-i
166 ENDIF
167 ELSEIF (ntype==1) THEN
168 nela=nela+1
169 kk=fac8(1,j)
170 kk=itabinv(ixs(1+kk,ii))
171 elema(1,nela)=kk
172 kk=fac8(2,j)
173 kk=itabinv(ixs(1+kk,ii))
174 elema(3,nela)=kk
175 kk=fac8(3,j)
176 kk=itabinv(ixs(1+kk,ii))
177 elema(2,nela)=kk
178 tagela(nela)=-i
179C
180 nela=nela+1
181 kk=fac8(1,j)
182 kk=itabinv(ixs(1+kk,ii))
183 elema(1,nela)=kk
184 kk=fac8(3,j)
185 kk=itabinv(ixs(1+kk,ii))
186 elema(3,nela)=kk
187 kk=fac8(4,j)
188 kk=itabinv(ixs(1+kk,ii))
189 elema(2,nela)=kk
190 tagela(nela)=-i
191 ENDIF
192 ENDIF
193 ENDDO
194C
195 DO j=1,8
196 jj=ixs(1+j,ii)
197 brna(j,i)=itabinv(jj)
198 ENDDO
199 ENDDO
200C
201 RETURN
202 END SUBROUTINE fvbric2
203 END MODULE fvbric2_mod
subroutine fvbric2(elem, ixs, nel, nbric, tbric, tfac, tagels, nela, ibufa, nna, elema, tagela, brna, nb_node)
Definition fvbric2.F:39