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

Go to the source code of this file.

Functions/Subroutines

subroutine i11optcd (cand_m, cand_s, x, i_stok, irects, irectm, gap, nin, v, gap_s, gap_m, igap, stfs, itask, nrts, stfm, gap_s_l, gap_m_l, count_remslv, ifpen, cand_fx, cand_fy, cand_fz, iform, drad, dgapload, lskyi_sms_new)

Function/Subroutine Documentation

◆ i11optcd()

subroutine i11optcd ( integer, dimension(*) cand_m,
integer, dimension(*) cand_s,
x,
integer i_stok,
integer, dimension(2,*) irects,
integer, dimension(2,*) irectm,
gap,
integer nin,
v,
gap_s,
gap_m,
integer igap,
stfs,
integer itask,
integer nrts,
stfm,
gap_s_l,
gap_m_l,
integer, dimension(*) count_remslv,
integer, dimension(*) ifpen,
cand_fx,
cand_fy,
cand_fz,
integer iform,
intent(in) drad,
intent(in) dgapload,
integer, intent(inout) lskyi_sms_new )

Definition at line 32 of file i11optcd.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 D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER IRECTS(2,*),IRECTM(2,*), CAND_M(*), CAND_S(*),
55 . I_STOK, NIN,IGAP ,ITASK, NRTS,COUNT_REMSLV(*),
56 . IFPEN(*),IFORM
57 my_real
58 . x(3,*),gap,gap_s(*),gap_m(*),v(3,*),stfs(*), stfm(*),
59 . gap_s_l(*),gap_m_l(*),cand_fx(*),cand_fy(*),cand_fz(*)
60 my_real , INTENT(IN) :: dgapload,drad
61 INTEGER,INTENT(INOUT) :: LSKYI_SMS_NEW
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "task_c.inc"
66#include "com01_c.inc"
67#include "param_c.inc"
68#include "parit_c.inc"
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER I , L, NN1, NN2
73 my_real
74 . xi,x1,x2,x3,x4,yi,y1,y2,y3,y4,zi,z1,z2,z3,z4,
75 . xmins,xmaxs,ymins,ymaxs,zmins,zmaxs,
76 . xminm,xmaxm,yminm,ymaxm,zminm,zmaxm,
77 . v12,v22,v32,v42,vv,gapvd
78 INTEGER MSEG,CT
79 my_real
80 . gapv(mvsiz),dtti(mvsiz)
81 INTEGER LIST(MVSIZ), LISTI(MVSIZ)
82 INTEGER IS,JS,LS,NLS,NLT,NSEG,NLF,II,NLS2
83 INTEGER N1(MVSIZ),N2(MVSIZ),M1(MVSIZ),M2(MVSIZ)
84 INTEGER SG, FIRST, LAST,COUNT_CAND
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 IF(nspmd>1) THEN
96C
97C Partage cand_n local / frontiere
98C
99 nls = 0
100 nls2 = nseg+1
101 DO is = 1, nseg
102 i=js+is
103 IF(cand_s(i)<=nrts)THEN
104 nls=nls+1
105 listi(nls)=is
106 ELSE
107 nls2=nls2-1
108 listi(nls2) = is
109 ENDIF
110 ENDDO
111 IF(igap==0)THEN
112 DO ls = 1, nls
113 is = listi(ls)
114 gapv(is)=gap
115 ENDDO
116 ELSE
117 DO ls = 1, nls
118 is = listi(ls)
119 i=js+is
120 gapv(is)=gap_s(cand_s(i))+gap_m(cand_m(i))
121 IF(igap==3)
122 . gapv(is)=min(gapv(is),
123 . gap_s_l(cand_s(i))+gap_m_l(cand_m(i)))
124 gapv(is)=max(gapv(is),gap)
125 ENDDO
126 ENDIF
127 ELSE
128 nls = nseg
129 IF(igap==0)THEN
130 DO is=1,nseg
131 gapv(is)=gap
132 listi(is)=is
133 ENDDO
134 ELSE
135 DO is=1,nseg
136 i=js+is
137 gapv(is)=gap_s(cand_s(i))+gap_m(cand_m(i))
138 IF(igap==3)
139 . gapv(is)=min(gapv(is),
140 . gap_s_l(cand_s(i))+gap_m_l(cand_m(i)))
141 gapv(is)=max(gapv(is),gap)
142 listi(is)=is
143 ENDDO
144 ENDIF
145 ENDIF
146C
147 nlf = 1
148 nlt = nls
149 nls=0
150 DO ls = nlf, nlt
151 is = listi(ls)
152 i=js+is
153 l = cand_s(i)
154 IF (stfs(l)/=zero) THEN
155 n1(is)=irects(1,l)
156 z1=x(3,n1(is))
157 n2(is)=irects(2,l)
158 z2=x(3,n2(is))
159 l = cand_m(i)
160 IF (stfm(l)/=zero) THEN
161
162 m1(is)=irectm(1,l)
163 z3=x(3,m1(is))
164 m2(is)=irectm(2,l)
165 z4=x(3,m2(is))
166 gapvd = max(gapv(is)+dgapload,drad)
167 zmins = min(z1,z2)-gapvd
168 zmaxs = max(z1,z2)+gapvd
169 zminm = min(z3,z4)-gapvd
170 zmaxm = max(z3,z4)+gapvd
171 IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
172 nls=nls+1
173 list(nls)=is
174 ENDIF
175 ENDIF
176 ENDIF
177 ENDDO
178C
179 nlt=nls
180 nls=0
181 DO ls=nlf,nlt
182 is=list(ls)
183 i=js+is
184 l = cand_s(i)
185 n1(is)=irects(1,l)
186 y1=x(2,n1(is))
187 n2(is)=irects(2,l)
188 y2=x(2,n2(is))
189 l = cand_m(i)
190 m1(is)=irectm(1,l)
191 y3=x(2,m1(is))
192 m2(is)=irectm(2,l)
193 y4=x(2,m2(is))
194 gapvd = max(gapv(is)+dgapload,drad)
195 ymins = min(y1,y2)-gapvd
196 ymaxs = max(y1,y2)+gapvd
197 yminm = min(y3,y4)-gapvd
198 ymaxm = max(y3,y4)+gapvd
199 IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
200 nls=nls+1
201 list(nls)=is
202 ENDIF
203 ENDDO
204C
205 DO ls=nlf,nls
206 is=list(ls)
207 i=js+is
208 l = cand_s(i)
209 n1(is)=irects(1,l)
210 x1=x(1,n1(is))
211 n2(is)=irects(2,l)
212 x2=x(1,n2(is))
213 l = cand_m(i)
214 m1(is)=irectm(1,l)
215 x3=x(1,m1(is))
216 m2(is)=irectm(2,l)
217 x4=x(1,m2(is))
218 gapvd = max(gapv(is)+dgapload,drad)
219 xmins = min(x1,x2)-gapvd
220 xmaxs = max(x1,x2)+gapvd
221 xminm = min(x3,x4)-gapvd
222 xmaxm = max(x3,x4)+gapvd
223 IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
224 cand_s(i) = -cand_s(i)
225 count_cand = count_cand+1
226 ENDIF
227 ENDDO
228C
229 IF(nspmd>1)THEN
230 nlf = nls2
231 nlt = nseg
232 IF(igap==0)THEN
233 DO ls=nlf, nlt
234 is = listi(ls)
235 gapv(is)=gap
236 ENDDO
237 ELSE
238 DO ls = nlf, nlt
239 is = listi(ls)
240 i=js+is
241 gapv(is)=gapfi(nin)%P(cand_s(i)-nrts)+gap_m(cand_m(i))
242 IF(igap==3)
243 . gapv(is)=min(gapv(is),
244 . gap_lfi(nin)%P(cand_s(i)-nrts)+
245 . max(gap_m(cand_m(i)),gap_m_l(cand_m(i))))
246 gapv(is)=max(gapv(is),gap)
247 ENDDO
248 ENDIF
249C
250 nls=0
251 DO ls = nlf, nlt
252C conserver LISTI et LIST pour optimiser le code genere (IA64)
253 is = listi(ls)
254 i=js+is
255 ii = cand_s(i)-nrts
256 IF (stifi(nin)%P(ii)/=zero) THEN
257 nn1 = 2*(ii-1)+1
258 nn2 = 2*ii
259 z1=xfi(nin)%P(3,nn1)
260 z2=xfi(nin)%P(3,nn2)
261 l = cand_m(i)
262 IF (stfm(l)/=zero) THEN
263 m1(is)=irectm(1,l)
264 z3=x(3,m1(is))
265 m2(is)=irectm(2,l)
266 z4=x(3,m2(is))
267 gapvd = max(gapv(is)+dgapload,drad)
268 zmins = min(z1,z2)-gapvd
269 zmaxs = max(z1,z2)+gapvd
270 zminm = min(z3,z4)-gapvd
271 zmaxm = max(z3,z4)+gapvd
272 IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
273 nls=nls+1
274 list(nls)=is
275 ENDIF
276 ENDIF
277 ENDIF
278 ENDDO
279C
280 nlf=1
281 nlt=nls
282 nls=0
283 DO ls=nlf,nlt
284 is=list(ls)
285 i=js+is
286 ii = cand_s(i)-nrts
287 nn1 = 2*(ii-1)+1
288 nn2 = 2*ii
289 y1=xfi(nin)%P(2,nn1)
290 y2=xfi(nin)%P(2,nn2)
291 l = cand_m(i)
292 m1(is)=irectm(1,l)
293 y3=x(2,m1(is))
294 m2(is)=irectm(2,l)
295 y4=x(2,m2(is))
296 gapvd = max(gapv(is)+dgapload,drad)
297 ymins = min(y1,y2)-gapvd
298 ymaxs = max(y1,y2)+gapvd
299 yminm = min(y3,y4)-gapvd
300 ymaxm = max(y3,y4)+gapvd
301 IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
302 nls=nls+1
303 list(nls)=is
304 ENDIF
305 ENDDO
306C
307 DO ls=nlf,nls
308 is=list(ls)
309 i=js+is
310 ii = cand_s(i)-nrts
311 nn1 = 2*(ii-1)+1
312 nn2 = 2*ii
313 x1=xfi(nin)%P(1,nn1)
314 x2=xfi(nin)%P(1,nn2)
315 l = cand_m(i)
316 m1(is)=irectm(1,l)
317 x3=x(1,m1(is))
318 m2(is)=irectm(2,l)
319 x4=x(1,m2(is))
320 gapvd = max(gapv(is)+dgapload,drad)
321 xmins = min(x1,x2)-gapvd
322 xmaxs = max(x1,x2)+gapvd
323 xminm = min(x3,x4)-gapvd
324 xmaxm = max(x3,x4)+gapvd
325 IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
326 cand_s(i) = -cand_s(i)
327 count_cand = count_cand+1
328 ct = ct+1
329 ENDIF
330 ENDDO
331 CALL sync_data(nls2)
332 END IF
333 js = js + nseg
334 ENDDO
335 IF (itask == 0 .AND. iform == 2) THEN
336 DO i=1,i_stok
337 IF (ifpen(i) == 0 ) THEN
338 cand_fx(i) = zero
339 cand_fy(i) = zero
340 cand_fz(i) = zero
341 ENDIF
342 ifpen(i) = 0
343 ENDDO
344 ENDIF
345C
346#include "lockon.inc"
347 lskyi_count=lskyi_count+count_cand*5
348 count_remslv(nin)=count_remslv(nin)+ct
349 lskyi_sms_new = lskyi_sms_new + count_cand
350#include "lockoff.inc"
351
352C
353 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
sync_data
subroutine sync_data(ii)
Definition machine.F:381
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