OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inelt.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!|| inelts ../starter/source/interfaces/inter3d1/inelt.F
25!||--- called by ------------------------------------------------------
26!|| i1chk3 ../starter/source/interfaces/inter3d1/i1chk3.F
27!|| i21els3 ../starter/source/interfaces/inter3d1/i21els3.F
28!|| i2_surfi ../starter/source/interfaces/inter3d1/i2_surfi.F90
29!|| i2chk3 ../starter/source/interfaces/inter3d1/i2chk3.F
30!|| i3sti3 ../starter/source/interfaces/inter3d1/i3sti3.f
31!|| i7sti3 ../starter/source/interfaces/inter3d1/i7sti3.F
32!|| i9sti3 ../starter/source/interfaces/int09/i9sti3.F
33!||--- calls -----------------------------------------------------
34!|| norma1 ../starter/source/interfaces/inter3d1/norma1.F
35!||--- uses -----------------------------------------------------
36!||====================================================================
37 SUBROUTINE inelts(X ,IRECT ,IXS ,NINT ,NEL ,
38 . I ,AREA ,NOINT ,IR ,SURF_ELTYP,
39 . SURF_ELEM)
40 use element_mod , only :nixs
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER NINT, NEL, I, NOINT,IR,SURF_ELTYP(*),SURF_ELEM(*)
52C REAL
53 my_real
54 . area
55 INTEGER IRECT(4,*), IXS(NIXS,*)
56C REAL
57 my_real
58 . x(3,*)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER IY(4), N, JJ, II, K, NN, KK, IC, IAD,
63 . NUSER, NUSERM
64C REAL
65 my_real
66 . n1, n2, n3, dds
67 my_real :: xx1(4), xx2(4),xx3(4),xs1,ys1,zs1,xc,yc,zc
68C-----------------------------------------------
69C E x t e r n a l F u n c t i o n s
70C-----------------------------------------------
71C
72 ic =0
73 nel=0
74 IF (i <= 0) RETURN
75 IF (surf_eltyp(i) /= 1) RETURN
76C
77 nel=surf_elem(i)
78C-----------------------------------------------
79C VERIFICATION OF THE ORIENTATION OF THE SEGMENTS
80C-----------------------------------------------
81 xs1=0.
82 ys1=0.
83 zs1=0.
84 DO 100 jj=1,4
85 nn=irect(jj,i)
86 iy(jj)=nn
87 xx1(jj)=x(1,nn)
88 xx2(jj)=x(2,nn)
89 xx3(jj)=x(3,nn)
90 xs1=xs1+.25*x(1,nn)
91 ys1=ys1+.25*x(2,nn)
92 100 zs1=zs1+.25*x(3,nn)
93C
94 CALL norma1(n1,n2,n3,area,xx1,xx2,xx3)
95 xc=0.
96 yc=0.
97 zc=0.
98 DO 110 k=1,8
99 kk=ixs(k+1,nel)
100 xc=xc+x(1,kk)
101 yc=yc+x(2,kk)
102 zc=zc+x(3,kk)
103 110 CONTINUE
104 xc=xc*one_over_8
105 yc=yc*one_over_8
106 zc=zc*one_over_8
107 IF(ir/=0) RETURN
108 IF(ic>=2)RETURN
109 dds=n1*(xc-xs1)+n2*(yc-ys1)+n3*(zc-zs1)
110 IF(dds<0) RETURN
111 IF(iy(3)==iy(4)) THEN
112 irect(1,i)=iy(2)
113 irect(2,i)=iy(1)
114 ELSE
115 DO 120 kk=1,4
116 120 irect(kk,i)=iy(4-kk+1)
117 ENDIF
118 RETURN
119C
120 END
121!||====================================================================
122!|| ineltc ../starter/source/interfaces/inter3d1/inelt.F
123!||--- called by ------------------------------------------------------
124!|| i1chk3 ../starter/source/interfaces/inter3d1/i1chk3.F
125!|| i20sti3 ../starter/source/interfaces/inter3d1/i20sti3.F
126!|| i21els3 ../starter/source/interfaces/inter3d1/i21els3.F
127!|| i24gapm ../starter/source/interfaces/inter3d1/i24sti3.F
128!|| i2_surfi ../starter/source/interfaces/inter3d1/i2_surfi.F90
129!|| i2chk3 ../starter/source/interfaces/inter3d1/i2chk3.F
130!|| i3sti3 ../starter/source/interfaces/inter3d1/i3sti3.F
131!|| i7sti3 ../starter/source/interfaces/inter3d1/i7sti3.F
132!||====================================================================
133 SUBROUTINE ineltc(NELC ,NELTG ,IS ,SURF_ELTYP, SURF_ELEM)
134C-----------------------------------------------
135C I m p l i c i t T y p e s
136C-----------------------------------------------
137#include "implicit_f.inc"
138C-----------------------------------------------
139C D u m m y A r g u m e n t s
140C-----------------------------------------------
141 INTEGER NELC, IS, NELTG,SURF_ELTYP(*),SURF_ELEM(*)
142C-----------------------------------------------
143C L o c a l V a r i a b l e s
144C-----------------------------------------------
145 INTEGER ELTYP
146C-----------------------------------------------
147 nelc=0
148 neltg=0
149
150 IF (is <= 0) RETURN
151 eltyp = surf_eltyp(is)
152 IF (eltyp == 3) THEN
153 nelc = surf_elem(is)
154 ELSEIF (eltyp == 7) THEN
155 neltg = surf_elem(is)
156 ENDIF
157!---
158 RETURN
159 END
160!||====================================================================
161!|| i20nelts ../starter/source/interfaces/inter3d1/inelt.F
162!||--- called by ------------------------------------------------------
163!|| i20sti3 ../starter/source/interfaces/inter3d1/i20sti3.F
164!||--- calls -----------------------------------------------------
165!|| norma1 ../starter/source/interfaces/inter3d1/norma1.F
166!||--- uses -----------------------------------------------------
167!||====================================================================
168 SUBROUTINE i20nelts(X ,IRECT ,IXS ,NINT ,NEL ,
169 . I ,AREA ,NOINT ,IR ,SURF_ELTYP,
170 . SURF_ELEM)
171 use element_mod , only : nixs
172C-----------------------------------------------
173C I m p l i c i t T y p e s
174C-----------------------------------------------
175#include "implicit_f.inc"
176C-----------------------------------------------
177C C o m m o n B l o c k s
178C-----------------------------------------------
179C-----------------------------------------------
180C D u m m y A r g u m e n t s
181C-----------------------------------------------
182 INTEGER NINT, NEL, I, NOINT,IR,SURF_ELTYP(*),SURF_ELEM(*)
183C REAL
184 my_real
185 . AREA
186 INTEGER IRECT(4), IXS(NIXS,*)
187C REAL
188 my_real
189 . x(3,*)
190C-----------------------------------------------
191C L o c a l V a r i a b l e s
192C-----------------------------------------------
193 INTEGER IY(4), N, JJ, II, K, NN, KK, IC, IAD,
194 . NUSER, NUSERM
195C REAL
196 my_real
197 . n1, n2, n3, dds
198 my_real xx1(4), xx2(4),xx3(4),xs1,ys1,zs1,xc,yc,zc
199C-----------------------------------------------
200C E x t e r n a l F u n c t i o n s
201C-----------------------------------------------
202C
203 ic =0
204 nel=0
205
206 IF (i <= 0) RETURN
207 IF (surf_eltyp(i) /= 1) RETURN
208C
209 nel=surf_elem(i)
210C-----------------------------------------------
211C VERIFICATION OF THE ORIENTATION OF THE SEGMENTS
212C-----------------------------------------------
213 xs1=0.
214 ys1=0.
215 zs1=0.
216 DO 100 jj=1,4
217 nn=irect(jj)
218 iy(jj)=nn
219 xx1(jj)=x(1,nn)
220 xx2(jj)=x(2,nn)
221 xx3(jj)=x(3,nn)
222 xs1=xs1+.25*x(1,nn)
223 ys1=ys1+.25*x(2,nn)
224 100 zs1=zs1+.25*x(3,nn)
225C
226 CALL norma1(n1,n2,n3,area,xx1,xx2,xx3)
227 xc=0.
228 yc=0.
229 zc=0.
230 DO 110 k=1,8
231 kk=ixs(k+1,nel)
232 xc=xc+x(1,kk)
233 yc=yc+x(2,kk)
234 zc=zc+x(3,kk)
235 110 CONTINUE
236 xc=xc*one_over_8
237 yc=yc*one_over_8
238 zc=zc*one_over_8
239 IF(ir/=0) RETURN
240 IF(ic>=2)RETURN
241 dds=n1*(xc-xs1)+n2*(yc-ys1)+n3*(zc-zs1)
242 IF(dds<0) RETURN
243 IF(iy(3)==iy(4)) THEN
244 irect(1)=iy(2)
245 irect(2)=iy(1)
246 ELSE
247 DO 120 kk=1,4
248 120 irect(kk)=iy(4-kk+1)
249 ENDIF
250 RETURN
251C
252 END
253!||====================================================================
254!|| ineltigeo ../starter/source/interfaces/inter3d1/inelt.F
255!||--- called by ------------------------------------------------------
256!|| i7sti3 ../starter/source/interfaces/inter3d1/i7sti3.F
257!||--- calls -----------------------------------------------------
258!|| norma1 ../starter/source/interfaces/inter3d1/norma1.F
259!||--- uses -----------------------------------------------------
260!||====================================================================
261 SUBROUTINE ineltigeo(XE ,IRECT ,IXS ,NINT ,NELIG3D ,
262 . I ,AREA ,NOINT ,IR ,SURF_ELTYP_IGE,
263 . IXIG3D ,KXIG3D ,IGEO ,SURF_ELEM_IGE)
264 use element_mod , only : nixs
265C-----------------------------------------------
266C I m p l i c i t T y p e s
267C-----------------------------------------------
268#include "implicit_f.inc"
269C-----------------------------------------------
270C C o m m o n B l o c k s
271C-----------------------------------------------
272#include "param_c.inc"
273C-----------------------------------------------
274C D u m m y A r g u m e n t s
275C-----------------------------------------------
276 INTEGER NINT, NELIG3D, I, NOINT,IR
277C REAL
278 my_real
279 . AREA
280 INTEGER IRECT(4,*), IXS(NIXS,*),SURF_ELTYP_IGE(*),
281 . SURF_ELEM_IGE(*),KXIG3D(NIXIG3D,*),IGEO(NPROPGI,*),
282 . ixig3d(*)
283C REAL
284 my_real
285 . xe(3,*)
286C-----------------------------------------------
287C L o c a l V a r i a b l e s
288C-----------------------------------------------
289 INTEGER IY(4), N, JJ, II, K, NN, KK, IC, IAD,
290 . nuser, nuserm, coin_ige(8), px, py, pz, ipid
291C REAL
292 my_real
293 . n1, n2, n3, dds
294 my_real :: xx1(4), xx2(4),xx3(4),xc,yc,zc,xs1,ys1,zs1
295C-----------------------------------------------
296C E x t e r n a l F u n c t i o n s
297C-----------------------------------------------
298C
299 ic =0
300 nelig3d=0
301 IF (surf_eltyp_ige(i) /= 101) RETURN
302C
303 nelig3d=surf_elem_ige(i)
304
305C-----------------------------------------------
306C VERIFICATION OF THE ORIENTATION OF THE SEGMENTS
307C-----------------------------------------------
308 xs1=0.
309 ys1=0.
310 zs1=0.
311 DO jj=1,4
312 nn=irect(jj,i)
313 iy(jj)=nn
314 xx1(jj)=xe(1,nn)
315 xx2(jj)=xe(2,nn)
316 xx3(jj)=xe(3,nn)
317 xs1=xs1+.25*xe(1,nn)
318 ys1=ys1+.25*xe(2,nn)
319 zs1=zs1+.25*xe(3,nn)
320 ENDDO
321C
322 CALL norma1(n1,n2,n3,area,xx1,xx2,xx3)
323 xc=0.
324 yc=0.
325 zc=0.
326
327 ipid = kxig3d(2,nelig3d)
328 px = igeo(41,ipid)-1
329 py = igeo(42,ipid)-1
330 pz = igeo(43,ipid)-1
331 coin_ige(1) = (px+1)*py+1
332 coin_ige(2) = (px+1)*(py+1)
333 coin_ige(3) = px+1
334 coin_ige(4) = 1
335 coin_ige(5) = (px+1)*(py+1)*pz+(px+1)*py+1
336 coin_ige(6) = (px+1)*(py+1)*(pz+1)
337 coin_ige(7) = (px+1)*(py+1)*pz+px+1
338 coin_ige(8) = (px+1)*(py+1)*pz+1
339
340 DO k=1,8
341 xc=xc+xe(1,ixig3d(kxig3d(4,nelig3d)+coin_ige(k)-1))
342 yc=yc+xe(2,ixig3d(kxig3d(4,nelig3d)+coin_ige(k)-1))
343 zc=zc+xe(3,ixig3d(kxig3d(4,nelig3d)+coin_ige(k)-1))
344 ENDDO
345 xc=xc*one_over_8
346 yc=yc*one_over_8
347 zc=zc*one_over_8
348 IF(ir/=0) RETURN
349 IF(ic>=2)RETURN
350 dds=n1*(xc-xs1)+n2*(yc-ys1)+n3*(zc-zs1)
351 IF(dds<0) RETURN
352 DO kk=1,4
353 irect(kk,i)=iy(4-kk+1)
354 ENDDO
355 RETURN
356C
357 END
358
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
i3sti3
subroutine i3sti3(x, irect, stf, ixs, pm, geo, nrt, ixc, stfn, nseg, lnsv, nint, nsn, nsv, slsfac, nty, gap, noint, ixtg, ir, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, thk, ixs10, ixs16, ixs20, id, titr, gapn, stf8, depth, fmax, igeo, fillsol, pm_stack, iworksh)
Definition i3sti3.F:49
i20nelts
subroutine i20nelts(x, irect, ixs, nint, nel, i, area, noint, ir, surf_eltyp, surf_elem)
Definition inelt.F:171
inelts
subroutine inelts(x, irect, ixs, nint, nel, i, area, noint, ir, surf_eltyp, surf_elem)
Definition inelt.F:40
ineltigeo
subroutine ineltigeo(xe, irect, ixs, nint, nelig3d, i, area, noint, ir, surf_eltyp_ige, ixig3d, kxig3d, igeo, surf_elem_ige)
Definition inelt.F:264
ineltc
subroutine ineltc(nelc, neltg, is, surf_eltyp, surf_elem)
Definition inelt.F:134
norma1
subroutine norma1(n1, n2, n3, area, xx1, xx2, xx3)
Definition norma1.F:38
starter
program starter
Definition starter.F:39