OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fvelsurf.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!|| fvelsurf ../starter/source/airbag/fvelsurf.F
25!||--- called by ------------------------------------------------------
26!|| fvbag_vertex ../starter/source/spmd/domain_decomposition/grid2mat.F
27!|| fvmesh0 ../starter/source/airbag/fvmesh0.F
28!|| init_monvol ../starter/source/airbag/init_monvol.F
29!||====================================================================
30 SUBROUTINE fvelsurf(IBUF, ELEM, ELEM_ID, IXC, IXTG, NEL,
31 . ELTG, MATTG, NB_NODE, FLAG)
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C C o m m o n B l o c k s
38C-----------------------------------------------
39#include "com04_c.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 INTEGER IXC(NIXC,*), IXTG(NIXTG,*)
44 INTEGER IBUF(*), ELEM(3,*), ELEM_ID(*)
45 INTEGER, DIMENSION(NEL), INTENT(INOUT) :: ELTG, MATTG
46 INTEGER NEL
47 INTEGER NB_NODE
48 LOGICAL :: FLAG
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER I, J, JJ, ICMAX, NC, I1, I2, I3, IFOUND
53 INTEGER K, KK, ITY
54 INTEGER, DIMENSION(:,:), ALLOCATABLE :: CNS
55 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG
56C-------------------------------------------------------------------
57C SEARCH SHELL ELEMENT TO WHICH BAG TRIANGLE BELONGS
58C-------------------------------------------------------------------
59 ALLOCATE(itag(nb_node))
60 IF (.NOT. flag) THEN
61 DO i=1,nb_node
62 itag(i)=0
63 ENDDO
64 DO i=1,numelc
65 DO j=1,4
66 jj=ixc(1+j,i)
67 itag(jj)=itag(jj)+1
68 ENDDO
69 ENDDO
70 DO i=1,numeltg
71 DO j=1,3
72 jj=ixtg(1+j,i)
73 itag(jj)=itag(jj)+1
74 ENDDO
75 ENDDO
76 icmax=0
77 DO i=1,nb_node
78 icmax=max(icmax,itag(i))
79 ENDDO
80C
81 ALLOCATE(cns(nb_node,1+icmax*2))
82 DO i=1,nb_node
83 cns(i,1)=0
84 ENDDO
85 DO i=1,numelc
86 DO j=1,4
87 jj=ixc(1+j,i)
88 nc=cns(jj,1)
89 nc=nc+1
90 cns(jj,1)=nc
91 cns(jj,1+2*(nc-1)+1)=1
92 cns(jj,1+2*(nc-1)+2)=i
93 ENDDO
94 ENDDO
95 DO i=1,numeltg
96 DO j=1,3
97 jj=ixtg(1+j,i)
98 nc=cns(jj,1)
99 nc=nc+1
100 cns(jj,1)=nc
101 cns(jj,1+2*(nc-1)+1)=2
102 cns(jj,1+2*(nc-1)+2)=i
103 ENDDO
104 ENDDO
105C
106 DO i=1,nb_node
107 itag(i) = 0
108 ENDDO
109 DO i=1,nel
110 i1=elem(1,i)
111 i2=elem(2,i)
112 i3=elem(3,i)
113 i1=ibuf(i1)
114 i2=ibuf(i2)
115 i3=ibuf(i3)
116 ifound=0
117 DO j=1,cns(i1,1)
118 ity=cns(i1,1+2*(j-1)+1)
119 jj=cns(i1,1+2*(j-1)+2)
120 IF (ity==1) THEN
121 DO k=1,4
122 kk=ixc(1+k,jj)
123 itag(kk)=1
124 ENDDO
125 IF (itag(i1)==1.AND.itag(i2)==1.AND.itag(i3)==1) THEN
126 IF (.NOT. flag) ifound=numelq+jj
127 IF (flag) THEN
128 IF(jj == elem_id(i)) ifound=numelq+jj
129 ENDIF
130 ENDIF
131 DO k=1,4
132 kk=ixc(1+k,jj)
133 itag(kk)=0
134 ENDDO
135 ELSEIF (ity==2) THEN
136 DO k=1,3
137 kk=ixtg(1+k,jj)
138 itag(kk)=1
139 ENDDO
140 IF (itag(i1)==1.AND.itag(i2)==1.AND.itag(i3)==1) THEN
141 IF (.NOT. flag) ifound=numelc+jj
142 IF (flag) THEN
143 IF (jj == elem_id(i)) ifound=numelq+numelc+jj
144 ENDIF
145 ENDIF
146 DO k=1,3
147 kk=ixtg(1+k,jj)
148 itag(kk)=0
149 ENDDO
150 ENDIF
151 ENDDO
152 IF (ifound/=0) GOTO 100
153 DO j=1,cns(i2,1)
154 ity=cns(i2,1+2*(j-1)+1)
155 jj=cns(i2,1+2*(j-1)+2)
156 IF (ity==1) THEN
157 DO k=1,4
158 kk=ixc(1+k,jj)
159 itag(kk)=1
160 ENDDO
161 IF (itag(i1)==1.AND.itag(i2)==1.AND.itag(i3)==1) THEN
162 IF (.NOT. flag) ifound=numelq+jj
163 IF (flag) THEN
164 IF (jj == elem_id(i)) ifound=numelq+jj
165 ENDIF
166 ENDIF
167 DO k=1,4
168 kk=ixc(1+k,jj)
169 itag(kk)=0
170 ENDDO
171 ELSEIF (ity==2) THEN
172 DO k=1,3
173 kk=ixtg(1+k,jj)
174 itag(kk)=1
175 ENDDO
176 IF (itag(i1)==1.AND.itag(i2)==1.AND.itag(i3)==1) THEN
177 IF (.NOT. flag) ifound=numelc+jj
178 IF (flag) THEN
179 IF( jj == elem_id(i)) ifound=numelq+numelc+jj
180 ENDIF
181 ENDIF
182 DO k=1,3
183 kk=ixtg(1+k,jj)
184 itag(kk)=0
185 ENDDO
186 ENDIF
187 ENDDO
188 IF (ifound/=0) GOTO 100
189 DO j=1,cns(i3,1)
190 ity=cns(i3,1+2*(j-1)+1)
191 jj=cns(i3,1+2*(j-1)+2)
192 IF (ity==1) THEN
193 DO k=1,4
194 kk=ixc(1+k,jj)
195 itag(kk)=1
196 ENDDO
197 IF (itag(i1)==1.AND.itag(i2)==1.AND.itag(i3)==1) THEN
198 IF (.NOT. flag) ifound=numelq+jj
199 IF (flag) THEN
200 IF (jj == elem_id(i)) ifound=numelq+jj
201 ENDIF
202 ENDIF
203 DO k=1,4
204 kk=ixc(1+k,jj)
205 itag(kk)=0
206 ENDDO
207 ELSEIF (ity==2) THEN
208 DO k=1,3
209 kk=ixtg(1+k,jj)
210 itag(kk)=1
211 ENDDO
212 IF (itag(i1)==1.AND.itag(i2)==1.AND.itag(i3)==1) THEN
213 IF (.NOT. flag) ifound=numelc+jj
214 IF (flag) THEN
215 IF (jj == elem_id(i)) ifound=numelq+numelc+jj
216 ENDIF
217 ENDIF
218 DO k=1,3
219 kk=ixtg(1+k,jj)
220 itag(kk)=0
221 ENDDO
222 ENDIF
223 ENDDO
224C
225 100 CONTINUE
226 eltg(i)=ifound
227 ENDDO
228 DEALLOCATE(itag)
229 DEALLOCATE(cns)
230C-----------------------
231C STORE MATERIAL NUMBER
232C-----------------------
233 DO i=1,nel
234 j=eltg(i)
235 IF (j<=numelc) THEN
236 mattg(i) =ixc(1,j)
237 ELSEIF (j>numelc) THEN
238 mattg(i) =ixtg(1,j-numelc)
239 ENDIF
240 ENDDO
241 ELSE
242 DO i=1,nel
243 j=eltg(i)
244 IF (j<=numelc) THEN
245 mattg(i) =ixc(1,j)
246 ELSEIF (j>numelc) THEN
247 mattg(i) =ixtg(1,j-numelc)
248 ENDIF
249 ENDDO
250 ENDIF
251C
252 RETURN
253 END
fvelsurf
subroutine fvelsurf(ibuf, elem, elem_id, ixc, ixtg, nel, eltg, mattg, nb_node, flag)
Definition fvelsurf.F:32
max
#define max(a, b)
Definition macros.h:21