OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i15can.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!|| i15can ../engine/source/interfaces/int15/i15can.F
25!||--- called by ------------------------------------------------------
26!|| i15cmp ../engine/source/interfaces/int15/i15cmp.F
27!||--- uses -----------------------------------------------------
28!|| groupdef_mod ../common_source/modules/groupdef_mod.F
29!||====================================================================
30 SUBROUTINE i15can(NSI ,KSI ,X ,KSURF ,IGRSURF ,
31 2 BUFSF ,NSC ,KSC ,NTC , KTC ,
32 3 IACTIV )
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE groupdef_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com04_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER NSI, NSC, NTC, KSURF, KSI(4,*),
49 . IACTIV(*),KSC(*), KTC(*)
50C REAL
51 my_real
52 . x(3,*), bufsf(*)
53 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER ADRBUF, I, IN1, IN2, IN3, IN4
58 my_real
59 . dgr,
60 . xm, ym, zm, xg, yg, zg, a, b, c, rot(9),
61 . an, bn, cn,
62 . xlmin, xlmax, ylmin, ylmax, zlmin, zlmax,
63 . xgmin, xgmax, ygmin, ygmax, zgmin, zgmax,
64 . x1, y1, z1,
65 . x2, y2, z2,
66 . x3, y3, z3,
67 . x4, y4, z4,
68 . xrmin, xrmax, yrmin, yrmax, zrmin, zrmax
69C-----------------------------------------------
70 adrbuf=igrsurf(ksurf)%IAD_BUFR
71 dgr=bufsf(adrbuf+36)
72 xm=bufsf(adrbuf+4)
73 ym=bufsf(adrbuf+5)
74 zm=bufsf(adrbuf+6)
75 a =bufsf(adrbuf+1)
76 b =bufsf(adrbuf+2)
77 c =bufsf(adrbuf+3)
78C---------------------------------
79C AN=A**DGR
80C BN=B**DGR
81C CN=C**DGR
82C AN=1./AN
83C BN=1./BN
84C CN=1./CN
85 DO i=1,9
86 rot(i)=bufsf(adrbuf+7+i-1)
87 END DO
88C----------------------------------
89C Boite englobante de l'ellipsoide dans le repere global.
90 xlmin=-a
91 xlmax= a
92 ylmin=-b
93 ylmax= b
94 zlmin=-c
95 zlmax= c
96 xgmin=rot(1)*xlmin+rot(4)*ylmin+rot(7)*zlmin
97 ygmin=rot(2)*xlmin+rot(5)*ylmin+rot(8)*zlmin
98 zgmin=rot(3)*xlmin+rot(6)*ylmin+rot(9)*zlmin
99 xgmax=xgmin
100 ygmax=ygmin
101 zgmax=zgmin
102 xg =rot(1)*xlmax+rot(4)*ylmin+rot(7)*zlmin
103 yg =rot(2)*xlmax+rot(5)*ylmin+rot(8)*zlmin
104 zg =rot(3)*xlmax+rot(6)*ylmin+rot(9)*zlmin
105 IF (xg<xgmin) xgmin=xg
106 IF (xg>xgmax) xgmax=xg
107 IF (yg<ygmin) ygmin=yg
108 IF (yg>ygmax) ygmax=yg
109 IF (zg<zgmin) zgmin=zg
110 IF (zg>zgmax) zgmax=zg
111 xg =rot(1)*xlmin+rot(4)*ylmax+rot(7)*zlmin
112 yg =rot(2)*xlmin+rot(5)*ylmax+rot(8)*zlmin
113 zg =rot(3)*xlmin+rot(6)*ylmax+rot(9)*zlmin
114 IF (xg<xgmin) xgmin=xg
115 IF (xg>xgmax) xgmax=xg
116 IF (yg<ygmin) ygmin=yg
117 IF (yg>ygmax) ygmax=yg
118 IF (zg<zgmin) zgmin=zg
119 IF (zg>zgmax) zgmax=zg
120 xg =rot(1)*xlmin+rot(4)*ylmin+rot(7)*zlmax
121 yg =rot(2)*xlmin+rot(5)*ylmin+rot(8)*zlmax
122 zg =rot(3)*xlmin+rot(6)*ylmin+rot(9)*zlmax
123 IF (xg<xgmin) xgmin=xg
124 IF (xg>xgmax) xgmax=xg
125 IF (yg<ygmin) ygmin=yg
126 IF (yg>ygmax) ygmax=yg
127 IF (zg<zgmin) zgmin=zg
128 IF (zg>zgmax) zgmax=zg
129 xg =rot(1)*xlmax+rot(4)*ylmax+rot(7)*zlmin
130 yg =rot(2)*xlmax+rot(5)*ylmax+rot(8)*zlmin
131 zg =rot(3)*xlmax+rot(6)*ylmax+rot(9)*zlmin
132 IF (xg<xgmin) xgmin=xg
133 IF (xg>xgmax) xgmax=xg
134 IF (yg<ygmin) ygmin=yg
135 IF (yg>ygmax) ygmax=yg
136 IF (zg<zgmin) zgmin=zg
137 IF (zg>zgmax) zgmax=zg
138 xg =rot(1)*xlmax+rot(4)*ylmin+rot(7)*zlmax
139 yg =rot(2)*xlmax+rot(5)*ylmin+rot(8)*zlmax
140 zg =rot(3)*xlmax+rot(6)*ylmin+rot(9)*zlmax
141 IF (xg<xgmin) xgmin=xg
142 IF (xg>xgmax) xgmax=xg
143 IF (yg<ygmin) ygmin=yg
144 IF (yg>ygmax) ygmax=yg
145 IF (zg<zgmin) zgmin=zg
146 IF (zg>zgmax) zgmax=zg
147 xg =rot(1)*xlmin+rot(4)*ylmax+rot(7)*zlmax
148 yg =rot(2)*xlmin+rot(5)*ylmax+rot(8)*zlmax
149 zg =rot(3)*xlmin+rot(6)*ylmax+rot(9)*zlmax
150 IF (xg<xgmin) xgmin=xg
151 IF (xg>xgmax) xgmax=xg
152 IF (yg<ygmin) ygmin=yg
153 IF (yg>ygmax) ygmax=yg
154 IF (zg<zgmin) zgmin=zg
155 IF (zg>zgmax) zgmax=zg
156 xg =rot(1)*xlmax+rot(4)*ylmax+rot(7)*zlmax
157 yg =rot(2)*xlmax+rot(5)*ylmax+rot(8)*zlmax
158 zg =rot(3)*xlmax+rot(6)*ylmax+rot(9)*zlmax
159 IF (xg<xgmin) xgmin=xg
160 IF (xg>xgmax) xgmax=xg
161 IF (yg<ygmin) ygmin=yg
162 IF (yg>ygmax) ygmax=yg
163 IF (zg<zgmin) zgmin=zg
164 IF (zg>zgmax) zgmax=zg
165C----------------------------------
166 nsc=0
167 ntc=0
168C------------------------
169 DO 110 i=1,nsi
170 IF (iactiv(i)==-1) GOTO 110
171 in1=ksi(1,i)
172 x1=x(1,in1)-xm
173 y1=x(2,in1)-ym
174 z1=x(3,in1)-zm
175 in2=ksi(2,i)
176 x2=x(1,in2)-xm
177 y2=x(2,in2)-ym
178 z2=x(3,in2)-zm
179 in3=ksi(3,i)
180 x3=x(1,in3)-xm
181 y3=x(2,in3)-ym
182 z3=x(3,in3)-zm
183 in4=ksi(4,i)
184 IF (in4/=in3) THEN
185 x4=x(1,in4)-xm
186 y4=x(2,in4)-ym
187 z4=x(3,in4)-zm
188 xrmin=x1
189 xrmax=x1
190 yrmin=y1
191 yrmax=y1
192 zrmin=z1
193 zrmax=z1
194 IF (x2<xrmin) xrmin=x2
195 IF (x2>xrmax) xrmax=x2
196 IF (y2<yrmin) yrmin=y2
197 IF (y2>yrmax) yrmax=y2
198 IF (z2<zrmin) zrmin=z2
199 IF (z2>zrmax) zrmax=z2
200 IF (x3<xrmin) xrmin=x3
201 IF (x3>xrmax) xrmax=x3
202 IF (y3<yrmin) yrmin=y3
203 IF (y3>yrmax) yrmax=y3
204 IF (z3<zrmin) zrmin=z3
205 IF (z3>zrmax) zrmax=z3
206 IF (x4<xrmin) xrmin=x4
207 IF (x4>xrmax) xrmax=x4
208 IF (y4<yrmin) yrmin=y4
209 IF (y4>yrmax) yrmax=y4
210 IF (z4<zrmin) zrmin=z4
211 IF (z4>zrmax) zrmax=z4
212 IF ( .NOT.( xrmax<xgmin.OR.xrmin>xgmax
213 . .OR.yrmax<ygmin.OR.yrmin>ygmax
214 . .OR.zrmax<zgmin.OR.zrmin>zgmax) ) THEN
215 nsc=nsc+1
216 ksc(nsc)=i
217 ENDIF
218 ELSE
219C---------------------------------
220C TRIANGLES.
221C---------------------------------
222 xrmin=x1
223 xrmax=x1
224 yrmin=y1
225 yrmax=y1
226 zrmin=z1
227 zrmax=z1
228 IF (x2<xrmin) xrmin=x2
229 IF (x2>xrmax) xrmax=x2
230 IF (y2<yrmin) yrmin=y2
231 IF (y2>yrmax) yrmax=y2
232 IF (z2<zrmin) zrmin=z2
233 IF (z2>zrmax) zrmax=z2
234 IF (x3<xrmin) xrmin=x3
235 IF (x3>xrmax) xrmax=x3
236 IF (y3<yrmin) yrmin=y3
237 IF (y3>yrmax) yrmax=y3
238 IF (z3<zrmin) zrmin=z3
239 IF (z3>zrmax) zrmax=z3
240 IF ( .NOT.( xrmax<xgmin.OR.xrmin>xgmax
241 . .OR.yrmax<ygmin.OR.yrmin>ygmax
242 . .OR.zrmax<zgmin.OR.zrmin>zgmax) ) THEN
243 ntc=ntc+1
244 ktc(ntc)=i
245 ENDIF
246 ENDIF
247110 CONTINUE
248C---------------------------------
249 RETURN
250 END
my_real
#define my_real
Definition cppsort.cpp:32
i15can
subroutine i15can(nsi, ksi, x, ksurf, igrsurf, bufsf, nsc, ksc, ntc, ktc, iactiv)
Definition i15can.F:33
groupdef_mod
Definition groupdef_mod.F:662