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