OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i21optcd.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!|| i21optcd ../engine/source/interfaces/int21/i21optcd.F
25!||--- called by ------------------------------------------------------
26!|| i21main_opt_tri ../engine/source/interfaces/intsort/i21main_opt_tri.F
27!||--- calls -----------------------------------------------------
28!|| i21dst3 ../engine/source/interfaces/int21/i21dst3.F
29!|| my_barrier ../engine/source/system/machine.F
30!|| startime ../engine/source/system/timer_mod.F90
31!||--- uses -----------------------------------------------------
32!|| timer_mod ../engine/source/system/timer_mod.F90
33!||====================================================================
34 SUBROUTINE i21optcd(TIMERS, CAND_E ,CAND_N ,XLOC ,I_STOK ,IRECT ,
35 2 GAP ,GAP_S ,IGAP ,NSN ,STFN ,
36 3 ITASK ,STF ,INACTI ,IFPEN ,FTXSAV ,
37 4 FTYSAV ,FTZSAV ,PENI ,NIN ,GAPMAX ,
38 5 ICURV ,IRTLM ,CSTS ,DEPTH ,NOD_NORMAL,
39 6 XM0 ,DRAD ,NB_STOK_N,NB_JLT,DGAPLOAD)
40 USE timer_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45#include "comlock.inc"
46C-----------------------------------------------
47C G l o b a l P a r a m e t e r s
48C-----------------------------------------------
49#include "mvsiz_p.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "param_c.inc"
54#include "task_c.inc"
55#include "parit_c.inc"
56#include "warn_c.inc"
57#include "timeri_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 TYPE(timer_) :: TIMERS
62 INTEGER IRECT(4,*), CAND_E(*), CAND_N(*), IFPEN(*),
63 . I_STOK,NIN,IGAP ,ITASK, NSN, INACTI,ICURV,
64 . IRTLM(2,*),NB_STOK_N(*),NB_JLT(*)
65 my_real
66 . xloc(3,*),gap,gap_s(*),stfn(*),stf(*),
67 . ftxsav(*), ftysav(*), ftzsav(*), peni(*),
68 . gapmax, csts(2,*), depth, nod_normal(3,*),
69 . xm0(3,*)
70 my_real , INTENT(IN) :: dgapload,drad
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER I,L,IS,JS,LS,NLS,NLT,NSEG,SG,FIRST,LAST,MSEG,NLF,II,J
75 INTEGER LIST(MVSIZ),IG(MVSIZ),IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),
76 . IX4(MVSIZ), LISTI(MVSIZ),COUNT_CAND,
77 . IX1_L(MVSIZ), IX2_L(MVSIZ), IX3_L(MVSIZ),IX4_L(MVSIZ)
78 my_real
79 . xi,x1,x2,x3,x4,yi,y1,y2,y3,y4,zi,z1,z2,z3,z4,
80 . xmin,xmax,ymin,ymax,zmin,zmax,v12,v22,v32,v42
81 my_real
82 . gapv(mvsiz),nod_normal_l(12,mvsiz),xe_l(12,mvsiz),
83 . xi_l(mvsiz), yi_l(mvsiz), zi_l(mvsiz),
84 . x1_l(mvsiz), x2_l(mvsiz), x3_l(mvsiz), x4_l(mvsiz),
85 . y1_l(mvsiz), y2_l(mvsiz), y3_l(mvsiz), y4_l(mvsiz),
86 . z1_l(mvsiz), z2_l(mvsiz), z3_l(mvsiz), z4_l(mvsiz),
87 . nnx1(mvsiz), nnx2(mvsiz), nnx3(mvsiz), nnx4(mvsiz),
88 . nny1(mvsiz), nny2(mvsiz), nny3(mvsiz), nny4(mvsiz),
89 . nnz1(mvsiz), nnz2(mvsiz), nnz3(mvsiz), nnz4(mvsiz)
90 my_real
91 . x0,y0,z0,xxx,yyy,zzz,curv_max,depth2,drad2,
92 . xx1 ,xx2 ,xx3 ,xx4 ,xx5 ,xx6 ,xx7 ,xx8 ,
93 . yy1 ,yy2 ,yy3 ,yy4 ,yy5 ,yy6 ,yy7 ,yy8 ,
94 . zz1 ,zz2 ,zz3 ,zz4 ,zz5 ,zz6 ,zz7 ,zz8 ,
95 . nx1 ,nx2 ,nx3 ,nx4 , ny1 ,ny2 ,ny3 ,ny4 ,
96 . nz1 ,nz2 ,nz3 ,nz4 ,gapf, marj
97C-----------------------------------------------
98 count_cand=0
99C-----------------------------------------------
100 depth2=depth*depth
101 drad2 =drad*drad
102C-----------------------------------------------
103 DO j=itask+1,nsn,nthread
104 irtlm(1,j)=0
105 ENDDO
106C
107 call my_barrier
108C
109C-----------------------------------------------
110 mseg = nvsiz
111 first = 1 + i_stok*itask / nthread
112 last = i_stok*(itask+1) / nthread
113 js = first-1
114 DO sg = first,last,mseg
115 nseg = min(mseg,last-js)
116
117 nls = nseg
118 IF(igap==0)THEN
119 DO is=1,nseg
120 gapv(is)=gap
121 listi(is)=is
122 ENDDO
123 ELSE
124 DO is=1,nseg
125 i=js+is
126 gapv(is)=gap_s(cand_n(i))
127 IF(gapmax/=zero)gapv(is)=min(gapv(is),gapmax)
128 gapv(is)=max(gapv(is),gap)
129 listi(is)=is
130 ENDDO
131 ENDIF
132C
133 IF (debug(3)>=1) nb_jlt(itask+1) = nb_jlt(itask+1) + nls
134C
135 nlf = 1
136 nlt = nls
137 nls=0
138 IF(icurv==3)THEN
139 DO ls = nlf, nlt
140 is = listi(ls)
141 i=js+is
142 l = cand_e(i)
143 IF(stf(l)/=zero.AND.stfn(cand_n(i))/=zero) THEN
144 ig(is) = cand_n(i)
145 xi = xloc(1,ig(is))
146 yi = xloc(2,ig(is))
147 zi = xloc(3,ig(is))
148 ix1(is)=irect(1,l)
149 ix2(is)=irect(2,l)
150 ix3(is)=irect(3,l)
151 ix4(is)=irect(4,l)
152 x1=xm0(1,ix1(is))
153 x2=xm0(1,ix2(is))
154 x3=xm0(1,ix3(is))
155 x4=xm0(1,ix4(is))
156 y1=xm0(2,ix1(is))
157 y2=xm0(2,ix2(is))
158 y3=xm0(2,ix3(is))
159 y4=xm0(2,ix4(is))
160 z1=xm0(3,ix1(is))
161 z2=xm0(3,ix2(is))
162 z3=xm0(3,ix3(is))
163 z4=xm0(3,ix4(is))
164 x0 = fourth*(x1+x2+x3+x4)
165 y0 = fourth*(y1+y2+y3+y4)
166 z0 = fourth*(z1+z2+z3+z4)
167 xxx=max(x1,x2,x3,x4)-min(x1,x2,x3,x4)
168 yyy=max(y1,y2,y3,y4)-min(y1,y2,y3,y4)
169 zzz=max(z1,z2,z3,z4)-min(z1,z2,z3,z4)
170 curv_max = half * max(xxx,yyy,zzz)
171 xmin = x0-curv_max-gapv(is)
172 ymin = y0-curv_max-gapv(is)
173 zmin = z0-curv_max-gapv(is)
174 xmax = x0+curv_max+gapv(is)
175 ymax = y0+curv_max+gapv(is)
176 zmax = z0+curv_max+gapv(is)
177 IF (xmin <= xi.AND.xmax >= xi.AND.
178 . ymin <= yi.AND.ymax >= yi.AND.
179 . zmin <= zi.AND.zmax >= zi) THEN
180 cand_n(i) = -cand_n(i)
181 count_cand = count_cand+1
182 ENDIF
183 ENDIF
184 ENDDO
185 ELSE
186#include "vectorize.inc"
187 DO ls = nlf, nlt
188C conserver LISTI et LIST pour optimiser le code genere (IA64)
189 is = listi(ls)
190 i=js+is
191 l = cand_e(i)
192 IF(stf(l)/=zero.AND.stfn(cand_n(i))/=zero) THEN ! Contact sorting optimization
193 ig(is) = cand_n(i)
194 gapf = max(gapv(is)+dgapload,drad)
195C
196 xi = xloc(1,ig(is)) ! Secnd node
197 yi = xloc(2,ig(is))
198 zi = xloc(3,ig(is))
199C
200 ix1(is)=irect(1,l) ! Main Segment
201 ix2(is)=irect(2,l)
202 ix3(is)=irect(3,l)
203 ix4(is)=irect(4,l)
204C
205 x1=xm0(1,ix1(is))
206 x2=xm0(1,ix2(is))
207 x3=xm0(1,ix3(is))
208 x4=xm0(1,ix4(is))
209C
210 y1=xm0(2,ix1(is))
211 y2=xm0(2,ix2(is))
212 y3=xm0(2,ix3(is))
213 y4=xm0(2,ix4(is))
214C
215 z1=xm0(3,ix1(is))
216 z2=xm0(3,ix2(is))
217 z3=xm0(3,ix3(is))
218 z4=xm0(3,ix4(is))
219C
220 nx1 = nod_normal(1,ix1(is))
221 ny1 = nod_normal(2,ix1(is))
222 nz1 = nod_normal(3,ix1(is))
223C
224 nx2 = nod_normal(1,ix2(is))
225 ny2 = nod_normal(2,ix2(is))
226 nz2 = nod_normal(3,ix2(is))
227C
228 nx3 = nod_normal(1,ix3(is))
229 ny3 = nod_normal(2,ix3(is))
230 nz3 = nod_normal(3,ix3(is))
231C
232 nx4 = nod_normal(1,ix4(is))
233 ny4 = nod_normal(2,ix4(is))
234 nz4 = nod_normal(3,ix4(is))
235C
236 xx1 = x1 + gapf*nx1
237 xx2 = x2 + gapf*nx2
238 xx3 = x3 - depth*nx3
239 xx4 = x4 - depth*nx4
240 xx5 = x1 - depth*nx1
241 xx6 = x2 - depth*nx2
242 xx7 = x3 + gapf*nx3
243 xx8 = x4 + gapf*nx4
244C
245 yy1 = y1 + gapf*ny1
246 yy2 = y2 + gapf*ny2
247 yy3 = y3 - depth*ny3
248 yy4 = y4 - depth*ny4
249 yy5 = y1 - depth*ny1
250 yy6 = y2 - depth*ny2
251 yy7 = y3 + gapf*ny3
252 yy8 = y4 + gapf*ny4
253C
254 zz1 = z1 + gapf*nz1
255 zz2 = z2 + gapf*nz2
256 zz3 = z3 - depth*nz3
257 zz4 = z4 - depth*nz4
258 zz5 = z1 - depth*nz1
259 zz6 = z2 - depth*nz2
260 zz7 = z3 + gapf*nz3
261 zz8 = z4 + gapf*nz4
262C
263 xmin = min(xx1,xx2,xx3,xx4,xx5,xx6,xx7,xx8)
264 ymin = min(yy1,yy2,yy3,yy4,yy5,yy6,yy7,yy8)
265 zmin = min(zz1,zz2,zz3,zz4,zz5,zz6,zz7,zz8)
266 xmax = max(xx1,xx2,xx3,xx4,xx5,xx6,xx7,xx8)
267 ymax = max(yy1,yy2,yy3,yy4,yy5,yy6,yy7,yy8)
268 zmax = max(zz1,zz2,zz3,zz4,zz5,zz6,zz7,zz8)
269C
270 marj = em02*(xmax-xmin)
271 xmin = xmin - marj
272 xmax = xmax + marj
273 marj = em02*(ymax-ymin)
274 ymin = ymin - marj
275 ymax = ymax + marj
276 marj = em02*(zmax-zmin)
277 zmin = zmin - marj
278 zmax = zmax + marj
279C
280 IF (xmin <= xi.AND.xmax >= xi.AND. ! If a node is in the box limited by GAP and DEPTH
281 . ymin <= yi.AND.ymax >= yi.AND. ! it is selected
282 . zmin <= zi.AND.zmax >= zi) THEN
283 nls=nls+1
284 list(nls)=is
285C
286 xi_l(nls) = xi
287 yi_l(nls) = yi
288 zi_l(nls) = zi
289C
290 ix1_l(nls) = ix1(is)
291 ix2_l(nls) = ix2(is)
292 ix3_l(nls) = ix3(is)
293 ix4_l(nls) = ix4(is)
294C
295 x1_l(nls) = x1
296 y1_l(nls) = y1
297 z1_l(nls) = z1
298 x2_l(nls) = x2
299 y2_l(nls) = y2
300 z2_l(nls) = z2
301 x3_l(nls) = x3
302 y3_l(nls) = y3
303 z3_l(nls) = z3
304 x4_l(nls) = x4
305 y4_l(nls) = y4
306 z4_l(nls) = z4
307C
308 nnx1(nls) = nx1
309 nny1(nls) = ny1
310 nnz1(nls) = nz1
311 nnx2(nls) = nx2
312 nny2(nls) = ny2
313 nnz2(nls) = nz2
314 nnx3(nls) = nx3
315 nny3(nls) = ny3
316 nnz3(nls) = nz3
317 nnx4(nls) = nx4
318 nny4(nls) = ny4
319 nnz4(nls) = nz4
320C
321 ENDIF
322 ENDIF
323 ENDDO
324C
325 IF (debug(3)>=1) nb_stok_n(itask+1) = nb_stok_n(itask+1) + nls
326C
327 IF (imonm > 0 .AND. itask+1 == 1) CALL startime(timers,77) ! Counting DST time
328C
329 nlt=nls
330 nls=0
331 CALL i21dst3(
332 . nlt ,list ,cand_n(js+1) ,cand_e(js+1) , ix1_l ,
333 . ix2_l ,ix3_l ,ix4_l ,gapv ,xi_l ,
334 . yi_l ,zi_l ,irtlm ,csts ,depth2 ,
335 . nnx1 ,nny1 ,nnz1 ,nnx2 ,nny2 ,
336 . nnz2 ,nnx3 ,nny3 ,nnz3 ,nnx4 ,
337 . nny4 ,nnz4 ,x1_l ,y1_l ,z1_l ,
338 . x2_l ,y2_l ,z2_l ,x3_l ,y3_l ,
339 . z3_l ,x4_l ,y4_l ,z4_l ,drad2 ,
340 . dgapload)
341 ENDIF
342 js = js + nseg
343 ENDDO
344
345C-----------------------------------------------
346C
347 call my_barrier
348C
349 DO j=itask+1,nsn,nthread
350 IF(irtlm(1,j) > 0)THEN
351ccc irtlm < 0 if gap < dist < dradiation
352ccc impact=impact+1
353 ifpen(j)=ifpen(j)+1
354 ELSEIF(ifpen(j)/=0)THEN
355 ftxsav(j)=zero
356 ftysav(j)=zero
357 ftzsav(j)=zero
358 peni(j) =zero
359 ifpen(j) =0
360 END IF
361 ENDDO
362C
363#include "lockon.inc"
364 lskyi_count=lskyi_count+count_cand*5
365#include "lockoff.inc"
366 call my_barrier
367C
368C-----------------------------------------------
369 RETURN
370 END
i21optcd
subroutine i21optcd(timers, cand_e, cand_n, xloc, i_stok, irect, gap, gap_s, igap, nsn, stfn, itask, stf, inacti, ifpen, ftxsav, ftysav, ftzsav, peni, nin, gapmax, icurv, irtlm, csts, depth, nod_normal, xm0, drad, nb_stok_n, nb_jlt, dgapload)
Definition i21optcd.F:40
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
i21dst3
subroutine i21dst3(jlt, cand_n, cand_e, irect, nsv, gap_s, x, irtlm, csts, depth, nod_normal, xm0, pene, peni, ifpen, igap, gap, gapmax, gapmin, drad, dgapload)
Definition i21dst3.F:34
my_barrier
subroutine my_barrier
Definition machine.F:31
startime
subroutine startime(event, itask)
Definition timer.F:93