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

Go to the source code of this file.

Functions/Subroutines

subroutine fvelsurf (ibuf, elem, elem_id, ixc, ixtg, nel, eltg, mattg, nb_node, flag)

Function/Subroutine Documentation

◆ fvelsurf()

subroutine fvelsurf ( integer, dimension(*) ibuf,
integer, dimension(3,*) elem,
integer, dimension(*) elem_id,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer nel,
integer, dimension(nel), intent(inout) eltg,
integer, dimension(nel), intent(inout) mattg,
integer nb_node,
logical flag )

Definition at line 31 of file fvelsurf.F.

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
max
#define max(a, b)
Definition macros.h:21