OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7optcd.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!|| i7optcd ../engine/source/interfaces/intsort/i7optcd.F
25!||--- called by ------------------------------------------------------
26!|| i7main_opt_tri ../engine/source/interfaces/intsort/i7main_opt_tri.F
27!||--- calls -----------------------------------------------------
28!|| sync_data ../engine/source/system/machine.F
29!||--- uses -----------------------------------------------------
30!|| tri7box ../engine/share/modules/tri7box.F
31!||====================================================================
32 SUBROUTINE i7optcd(NSV ,CAND_E ,CAND_N ,X ,I_STOK ,
33 2 IRECT ,GAP ,GAP_S ,GAP_M ,IGAP ,
34 3 STFN ,ITASK ,STF ,IFQ ,IFPEN ,
35 4 CAND_FX ,CAND_FY ,CAND_FZ ,NIN ,NSN ,
36 5 GAPMAX ,ICURV ,GAP_S_L ,GAP_M_L ,
37 6 COUNT_REMSLV ,GAPMIN ,DRAD ,DGAPLOAD ,
38 7 LSKYI_SMS_NEW)
39C===============================================================
40C M o d u l e s
41C-----------------------------------------------
42 USE tri7box
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47#include "comlock.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "param_c.inc"
57#include "task_c.inc"
58#include "impl1_c.inc"
59#include "parit_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*), IFPEN(*),
64 . I_STOK,NIN,IGAP ,ITASK, NSN, IFQ,ICURV,COUNT_REMSLV(*)
65 my_real
66 . X(3,*),GAP,GAP_S(*),GAP_M(*),STFN(*),STF(*),
67 . CAND_FX(*),CAND_FY(*),CAND_FZ(*),
68 . GAPMAX,GAP_S_L(*),GAP_M_L(*),GAPMIN
69 my_real , INTENT(IN) :: dgapload ,drad
70 INTEGER,INTENT(INOUT) :: LSKYI_SMS_NEW
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,NLS2,SG,FIRST,LAST,MSEG,NLF,II
75 INTEGER LIST(MVSIZ),IG(MVSIZ),IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),
76 . ix4(mvsiz), listi(mvsiz),count_cand,ct
77 my_real
78 . xi,x1,x2,x3,x4,yi,y1,y2,y3,y4,zi,z1,z2,z3,z4,
79 . xmin,xmax,ymin,ymax,zmin,zmax,v12,v22,v32,v42
80 my_real
81 . gapv(mvsiz)
82 my_real
83 . x0,y0,z0,xxx,yyy,zzz,curv_max,gapf
84
85C-----------------------------------------------
86 count_cand=0
87 ct = 0
88 mseg = nvsiz
89 first = 1 + i_stok*itask / nthread
90 last = i_stok*(itask+1) / nthread
91 js = first-1
92 DO sg = first,last,mseg
93 nseg = min(mseg,last-js)
94 nls=0
95
96 IF(nspmd>1) THEN
97C
98C Partage cand_n local / frontiere
99C
100 nls = 0
101 nls2 = nseg+1
102 DO is = 1, nseg
103 i=js+is
104 IF(cand_n(i)<=nsn)THEN
105 nls=nls+1
106 listi(nls)=is
107 ELSE
108 nls2=nls2-1
109 listi(nls2) = is
110 ENDIF
111 ENDDO
112 IF(igap==0)THEN
113 DO ls = 1, nls
114 is = listi(ls)
115 gapv(is)=gap
116 ENDDO
117 ELSE
118 DO ls = 1, nls
119 is = listi(ls)
120 i=js+is
121 gapv(is)=gap_s(cand_n(i))+gap_m(cand_e(i))
122 IF(igap==3)
123 . gapv(is)=min(gapv(is),
124 . gap_s_l(cand_n(i))+gap_m_l(cand_e(i)))
125 gapv(is)=min(gapv(is),gapmax)
126 gapv(is)=max(gapv(is),gapmin)
127 ENDDO
128 ENDIF
129 ELSE
130 nls = nseg
131 IF(igap==0)THEN
132 DO is=1,nseg
133 gapv(is)=gap
134 listi(is)=is
135 ENDDO
136 ELSE
137 DO is=1,nseg
138 i=js+is
139 gapv(is)=gap_s(cand_n(i))+gap_m(cand_e(i))
140 IF(igap==3)
141 . gapv(is)=min(gapv(is),
142 . gap_s_l(cand_n(i))+gap_m_l(cand_e(i)))
143 gapv(is)=min(gapv(is),gapmax)
144 gapv(is)=max(gapv(is),gapmin)
145 listi(is)=is
146 ENDDO
147 ENDIF
148 ENDIF
149C
150 nlf = 1
151 nlt = nls
152 nls=0
153 IF(icurv/=0)THEN
154 DO ls = nlf, nlt
155 is = listi(ls)
156 i=js+is
157 l = cand_e(i)
158 IF(stf(l)/=zero.AND.stfn(cand_n(i))/=zero) THEN
159 ig(is) = nsv(cand_n(i))
160 gapf = max(gapv(is)+dgapload,drad)
161 xi = x(1,ig(is))
162 yi = x(2,ig(is))
163 zi = x(3,ig(is))
164 ix1(is)=irect(1,l)
165 ix2(is)=irect(2,l)
166 ix3(is)=irect(3,l)
167 ix4(is)=irect(4,l)
168 x1=x(1,ix1(is))
169 x2=x(1,ix2(is))
170 x3=x(1,ix3(is))
171 x4=x(1,ix4(is))
172 y1=x(2,ix1(is))
173 y2=x(2,ix2(is))
174 y3=x(2,ix3(is))
175 y4=x(2,ix4(is))
176 z1=x(3,ix1(is))
177 z2=x(3,ix2(is))
178 z3=x(3,ix3(is))
179 z4=x(3,ix4(is))
180 x0 = fourth*(x1+x2+x3+x4)
181 y0 = fourth*(y1+y2+y3+y4)
182 z0 = fourth*(z1+z2+z3+z4)
183 xxx=max(x1,x2,x3,x4)-min(x1,x2,x3,x4)
184 yyy=max(y1,y2,y3,y4)-min(y1,y2,y3,y4)
185 zzz=max(z1,z2,z3,z4)-min(z1,z2,z3,z4)
186 curv_max = half * max(xxx,yyy,zzz)
187 xmin = x0-curv_max-gapf
188 ymin = y0-curv_max-gapf
189 zmin = z0-curv_max-gapf
190 xmax = x0+curv_max+gapf
191 ymax = y0+curv_max+gapf
192 zmax = z0+curv_max+gapf
193 IF (xmin <= xi.AND.xmax >= xi.AND.
194 . ymin <= yi.AND.ymax >= yi.AND.
195 . zmin <= zi.AND.zmax >= zi) THEN
196 cand_n(i) = -cand_n(i)
197 count_cand = count_cand+1
198 ENDIF
199 ENDIF
200 ENDDO
201 ELSE
202 DO ls = nlf, nlt
203C conserver LISTI et LIST pour optimiser le code genere (IA64)
204 is = listi(ls)
205 i=js+is
206 l = cand_e(i)
207 IF(stf(l)/=zero.AND.stfn(cand_n(i))/=zero) THEN
208 ig(is) = nsv(cand_n(i))
209 gapf = max(gapv(is)+dgapload,drad)
210 zi = x(3,ig(is))
211 ix1(is)=irect(1,l)
212 z1=x(3,ix1(is))
213 ix2(is)=irect(2,l)
214 z2=x(3,ix2(is))
215 ix3(is)=irect(3,l)
216 z3=x(3,ix3(is))
217 ix4(is)=irect(4,l)
218 z4=x(3,ix4(is))
219 zmin = min(z1,z2,z3,z4)-gapf
220 zmax = max(z1,z2,z3,z4)+gapf
221 yi=x(2,ig(is))
222 y1=x(2,ix1(is))
223 y2=x(2,ix2(is))
224 y3=x(2,ix3(is))
225 y4=x(2,ix4(is))
226 ymin = min(y1,y2,y3,y4)-gapf
227 ymax = max(y1,y2,y3,y4)+gapf
228 xi=x(1,ig(is))
229 x1=x(1,ix1(is))
230 x2=x(1,ix2(is))
231 x3=x(1,ix3(is))
232 x4=x(1,ix4(is))
233 xmin = min(x1,x2,x3,x4)-gapf
234 xmax = max(x1,x2,x3,x4)+gapf
235 IF (zmin<=zi.AND.zmax>=zi) THEN
236 IF (ymin<=yi.AND.ymax>=yi) THEN
237 IF (xmin<=xi.AND.xmax>=xi) THEN
238 i=js+is
239 cand_n(i) = -cand_n(i)
240 count_cand = count_cand+1
241 ENDIF
242 ENDIF
243 ENDIF
244 ENDIF
245 ENDDO
246 ENDIF
247
248 IF(nspmd>1)THEN
249 nlf = nls2
250 nlt = nseg
251 IF(igap==0)THEN
252 DO ls = nlf, nlt
253 is = listi(ls)
254 gapv(is)=gap
255 ENDDO
256 ELSE
257 IF(gapmax/=zero)THEN
258 DO ls = nlf, nlt
259 is = listi(ls)
260 i=js+is
261 gapv(is)=gapfi(nin)%P(cand_n(i)-nsn)+gap_m(cand_e(i))
262 IF(igap==3)
263 . gapv(is)=min(gapv(is),
264 . gap_lfi(nin)%P(cand_n(i)-nsn)+
265 . max(gap_m(cand_e(i)),gap_m_l(cand_e(i))))
266 gapv(is)=min(gapv(is),gapmax)
267 gapv(is)=max(gapv(is),gapmin)
268 ENDDO
269 ELSE
270 DO ls = nlf, nlt
271 is = listi(ls)
272 i=js+is
273 gapv(is)=gapfi(nin)%P(cand_n(i)-nsn)+gap_m(cand_e(i))
274 IF(igap==3)
275 . gapv(is)=min(gapv(is),
276 . gap_lfi(nin)%P(cand_n(i)-nsn)+
277 . max(gap_m(cand_e(i)),gap_m_l(cand_e(i))))
278 gapv(is)=max(gapv(is),gapmin)
279 ENDDO
280 ENDIF
281 ENDIF
282 IF(icurv/=0)THEN
283 DO ls = nlf, nlt
284 is = listi(ls)
285 i=js+is
286 ii = cand_n(i)-nsn
287 l = cand_e(i)
288 IF(stf(l)/=zero.AND.stifi(nin)%P(ii)/=zero) THEN
289 gapf = max(gapv(is)+dgapload,drad)
290 xi = xfi(nin)%P(1,ii)
291 yi = xfi(nin)%P(2,ii)
292 zi = xfi(nin)%P(3,ii)
293 ix1(is)=irect(1,l)
294 ix2(is)=irect(2,l)
295 ix3(is)=irect(3,l)
296 ix4(is)=irect(4,l)
297 x1=x(1,ix1(is))
298 x2=x(1,ix2(is))
299 x3=x(1,ix3(is))
300 x4=x(1,ix4(is))
301 y1=x(2,ix1(is))
302 y2=x(2,ix2(is))
303 y3=x(2,ix3(is))
304 y4=x(2,ix4(is))
305 z1=x(3,ix1(is))
306 z2=x(3,ix2(is))
307 z3=x(3,ix3(is))
308 z4=x(3,ix4(is))
309 x0 = fourth*(x1+x2+x3+x4)
310 y0 = fourth*(y1+y2+y3+y4)
311 z0 = fourth*(z1+z2+z3+z4)
312 xxx=max(x1,x2,x3,x4)-min(x1,x2,x3,x4)
313 yyy=max(y1,y2,y3,y4)-min(y1,y2,y3,y4)
314 zzz=max(z1,z2,z3,z4)-min(z1,z2,z3,z4)
315 curv_max = half * max(xxx,yyy,zzz)
316 xmin = x0-curv_max-gapf
317 ymin = y0-curv_max-gapf
318 zmin = z0-curv_max-gapf
319 xmax = x0+curv_max+gapf
320 ymax = y0+curv_max+gapf
321 zmax = z0+curv_max+gapf
322 IF (xmin <= xi.AND.xmax >= xi.AND.
323 . ymin <= yi.AND.ymax >= yi.AND.
324 . zmin <= zi.AND.zmax >= zi) THEN
325 cand_n(i) = -cand_n(i)
326 count_cand = count_cand + 1
327 ct = ct +1
328 ENDIF
329 END IF
330 END DO
331 ELSE
332 nls=0
333 DO ls = nlf, nlt
334 is = listi(ls)
335 i=js+is
336 ii = cand_n(i)-nsn
337 l = cand_e(i)
338 IF(stf(l)/=zero.AND.stifi(nin)%P(ii)/=zero) THEN
339 gapf = max(gapv(is)+dgapload,drad)
340 zi = xfi(nin)%P(3,ii)
341 ix1(is)=irect(1,l)
342 z1=x(3,ix1(is))
343 ix2(is)=irect(2,l)
344 z2=x(3,ix2(is))
345 ix3(is)=irect(3,l)
346 z3=x(3,ix3(is))
347 ix4(is)=irect(4,l)
348 z4=x(3,ix4(is))
349 zmin = min(z1,z2,z3,z4)-gapf
350 zmax = max(z1,z2,z3,z4)+gapf
351 IF (zmin<=zi.AND.zmax>=zi) THEN
352 nls=nls+1
353 list(nls)=is
354 ENDIF
355 ENDIF
356 ENDDO
357C
358 nlf=1
359 nlt=nls
360 nls=0
361 DO ls=nlf,nlt
362 is=list(ls)
363 gapf = max(gapv(is)+dgapload,drad)
364 i=js+is
365 ii=cand_n(i)-nsn
366 yi=xfi(nin)%P(2,ii)
367 y1=x(2,ix1(is))
368 y2=x(2,ix2(is))
369 y3=x(2,ix3(is))
370 y4=x(2,ix4(is))
371 ymin = min(y1,y2,y3,y4)-gapf
372 ymax = max(y1,y2,y3,y4)+gapf
373 IF (ymin<=yi.AND.ymax>=yi) THEN
374 nls=nls+1
375 list(nls)=is
376 ENDIF
377 ENDDO
378C
379 DO ls=nlf,nls
380 is=list(ls)
381 gapf = max(gapv(is)+dgapload,drad)
382 i=js+is
383 ii = cand_n(i)-nsn
384 xi = xfi(nin)%P(1,ii)
385 x1=x(1,ix1(is))
386 x2=x(1,ix2(is))
387 x3=x(1,ix3(is))
388 x4=x(1,ix4(is))
389 xmin = min(x1,x2,x3,x4)-gapf
390 xmax = max(x1,x2,x3,x4)+gapf
391 IF (xmin<=xi.AND.xmax>=xi) THEN
392 cand_n(i) = -cand_n(i)
393 count_cand = count_cand+1
394 ct = ct + 1
395 ENDIF
396 ENDDO
397 END IF
398 ELSE
399 CALL sync_data(nls2)
400 ENDIF
401 js = js + nseg
402 ENDDO
403 IF (ifq > 0) THEN
404 DO i=first,last
405 IF (ifpen(i) == 0 .AND. imconv == 1) THEN
406 cand_fx(i) = zero
407 cand_fy(i) = zero
408 cand_fz(i) = zero
409 ENDIF
410 ifpen(i) = 0
411 ENDDO
412 ENDIF
413C
414 IF(count_cand > 0 .OR. ct > 0) THEN
415#include "lockon.inc"
416 lskyi_count=lskyi_count+count_cand*5
417 count_remslv(nin)=count_remslv(nin)+ct
418 lskyi_sms_new = lskyi_sms_new + count_cand
419#include "lockoff.inc"
420 ENDIF
421
422 RETURN
423 END
sync_data
subroutine sync_data(ii)
Definition machine.F:381
i7optcd
subroutine i7optcd(nsv, cand_e, cand_n, x, i_stok, irect, gap, gap_s, gap_m, igap, stfn, itask, stf, ifq, ifpen, cand_fx, cand_fy, cand_fz, nin, nsn, gapmax, icurv, gap_s_l, gap_m_l, count_remslv, gapmin, drad, dgapload, lskyi_sms_new)
Definition i7optcd.F:39
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
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::gap_lfi
type(real_pointer), dimension(:), allocatable gap_lfi
Definition tri7box.F:449
tri7box::gapfi
type(real_pointer), dimension(:), allocatable gapfi
Definition tri7box.F:449
tri7box::xfi
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459