OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i23optcd.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "parit_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i23optcd (cand_e, cand_n, x, i_stok, irect, gap, gap_s, igap, nsn, stfn, itask, stf, inacti, ftxsav, ftysav, ftzsav, cand_p, nin, gapmax, icurv, count_remslv, gap_m, msr, nsv, gapmin)

Function/Subroutine Documentation

◆ i23optcd()

subroutine i23optcd ( integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
x,
integer i_stok,
integer, dimension(4,*) irect,
gap,
gap_s,
integer igap,
integer nsn,
stfn,
integer itask,
stf,
integer inacti,
ftxsav,
ftysav,
ftzsav,
cand_p,
integer nin,
gapmax,
integer icurv,
integer, dimension(*) count_remslv,
gap_m,
integer, dimension(*) msr,
integer, dimension(*) nsv,
gapmin )

Definition at line 32 of file i23optcd.F.

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