OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20optcd.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!|| i20optcd ../engine/source/interfaces/intsort/i20optcd.F
25!||--- called by ------------------------------------------------------
26!|| i20main_opt_tri ../engine/source/interfaces/intsort/i20main_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 i20optcd(NSV ,CAND_E ,CAND_N ,XA ,I_STOK ,
33 2 IRECT ,GAP ,GAP_S ,GAP_M ,IGAP ,
34 3 STFA ,ITASK ,STF ,IFQ ,IFPEN ,
35 4 CAND_FX,CAND_FY,CAND_FZ,NIN ,NSN ,
36 5 GAPMAX ,ICURV ,COUNT_REMSLV )
37C=======================================================================
38C M o d u l e s
39C-----------------------------------------------
40 USE tri7box
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 "com01_c.inc"
54#include "param_c.inc"
55#include "task_c.inc"
56#include "parit_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*), IFPEN(*),
61 . I_STOK,NIN,IGAP ,ITASK, NSN, IFQ,ICURV,COUNT_REMSLV(*)
62 my_real
63 . XA(3,*),GAP,GAP_S(*),GAP_M(*),STFA(*),STF(*),
64 . cand_fx(*),cand_fy(*),cand_fz(*),
65 . gapmax
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I,L,IS,JS,LS,NLS,NLT,NSEG,NLS2,SG,FIRST,LAST,MSEG,NLF,II
70 INTEGER LIST(MVSIZ), IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ),
71 . IX4(MVSIZ), LISTI(MVSIZ),IL(MVSIZ),COUNT_CAND,CT
72 my_real
73 . xi,x1,x2,x3,x4,yi,y1,y2,y3,y4,zi,z1,z2,z3,z4,
74 . xmin,xmax,ymin,ymax,zmin,zmax
75 my_real
76 . gapv(mvsiz)
77 my_real
78 . x0,y0,z0,xxx,yyy,zzz,curv_max
79C-----------------------------------------------
80 ct = 0
81 count_cand=0
82 mseg = nvsiz
83 first = 1 + i_stok*itask / nthread
84 last = i_stok*(itask+1) / nthread
85 js = first-1
86 DO sg = first,last,mseg
87 nseg = min(mseg,last-js)
88 nls=0
89 IF(nspmd>1) THEN
90C
91C Partage cand_n local / frontiere
92C
93 nls = 0
94 nls2 = nseg+1
95 DO is = 1, nseg
96 i=js+is
97 IF(cand_n(i)<=nsn)THEN
98 nls=nls+1
99 listi(nls)=is
100 ELSE
101 nls2=nls2-1
102 listi(nls2) = is
103 ENDIF
104 ENDDO
105 IF(igap==0)THEN
106 DO ls = 1, nls
107 is = listi(ls)
108 gapv(is)=gap
109 ENDDO
110 ELSE
111 DO ls = 1, nls
112 is = listi(ls)
113 i=js+is
114 gapv(is)=gap_s(cand_n(i))+gap_m(cand_e(i))
115 IF(gapmax/=zero)gapv(is)=min(gapv(is),gapmax)
116 gapv(is)=max(gapv(is),gap)
117 ENDDO
118 ENDIF
119 ELSE
120 nls = nseg
121 IF(igap==0)THEN
122 DO is=1,nseg
123 gapv(is)=gap
124 listi(is)=is
125 ENDDO
126 ELSE
127 DO is=1,nseg
128 i=js+is
129 gapv(is)=gap_s(cand_n(i))+gap_m(cand_e(i))
130 IF(gapmax/=zero)gapv(is)=min(gapv(is),gapmax)
131 gapv(is)=max(gapv(is),gap)
132 listi(is)=is
133 ENDDO
134 ENDIF
135 ENDIF
136C
137 nlf = 1
138 nlt = nls
139 nls=0
140 IF(icurv/=0)THEN
141#include "vectorize.inc"
142 DO ls = nlf, nlt
143 is = listi(ls)
144 i=js+is
145 l = cand_e(i)
146 IF(stf(l)/=zero.AND.stfa(nsv(cand_n(i)))/=zero) THEN
147
148c IG(IS) = NSV(CAND_N(I))
149c XI = X(1,IG(IS))
150c YI = X(2,IG(IS))
151c ZI = X(3,IG(IS))
152 il(is) = nsv(cand_n(i))
153 xi = xa(1,il(is))
154 yi = xa(2,il(is))
155 zi = xa(3,il(is))
156
157 ix1(is)=irect(1,l)
158 ix2(is)=irect(2,l)
159 ix3(is)=irect(3,l)
160 ix4(is)=irect(4,l)
161 x1=xa(1,ix1(is))
162 x2=xa(1,ix2(is))
163 x3=xa(1,ix3(is))
164 x4=xa(1,ix4(is))
165 y1=xa(2,ix1(is))
166 y2=xa(2,ix2(is))
167 y3=xa(2,ix3(is))
168 y4=xa(2,ix4(is))
169 z1=xa(3,ix1(is))
170 z2=xa(3,ix2(is))
171 z3=xa(3,ix3(is))
172 z4=xa(3,ix4(is))
173 x0 = fourth*(x1+x2+x3+x4)
174 y0 = fourth*(y1+y2+y3+y4)
175 z0 = fourth*(z1+z2+z3+z4)
176 xxx=max(x1,x2,x3,x4)-min(x1,x2,x3,x4)
177 yyy=max(y1,y2,y3,y4)-min(y1,y2,y3,y4)
178 zzz=max(z1,z2,z3,z4)-min(z1,z2,z3,z4)
179 curv_max = half * max(xxx,yyy,zzz)
180 xmin = x0-curv_max-gapv(is)
181 ymin = y0-curv_max-gapv(is)
182 zmin = z0-curv_max-gapv(is)
183 xmax = x0+curv_max+gapv(is)
184 ymax = y0+curv_max+gapv(is)
185 zmax = z0+curv_max+gapv(is)
186 IF (xmin <= xi.AND.xmax >= xi.AND.
187 . ymin <= yi.AND.ymax >= yi.AND.
188 . zmin <= zi.AND.zmax >= zi) cand_n(i) = -cand_n(i)
189 ENDIF
190 ENDDO
191 ELSE
192 DO ls = nlf, nlt
193C keep LISTI and LIST to optimize generated code (IA64)
194 is = listi(ls)
195 i=js+is
196 l = cand_e(i)
197 IF(stf(l)/=zero.AND.stfa(nsv(cand_n(i)))/=zero) THEN
198 il(is) = nsv(cand_n(i))
199 zi = xa(3,il(is))
200
201 ix1(is)=irect(1,l)
202 z1=xa(3,ix1(is))
203 ix2(is)=irect(2,l)
204 z2=xa(3,ix2(is))
205 ix3(is)=irect(3,l)
206 z3=xa(3,ix3(is))
207 ix4(is)=irect(4,l)
208 z4=xa(3,ix4(is))
209 zmin = min(z1,z2,z3,z4)-gapv(is)
210 zmax = max(z1,z2,z3,z4)+gapv(is)
211 IF (zmin<=zi.AND.zmax>=zi) THEN
212 nls=nls+1
213 list(nls)=is
214 ENDIF
215 ENDIF
216 ENDDO
217C
218 nlt=nls
219 nls=0
220 DO ls=nlf,nlt
221 is=list(ls)
222
223 yi=xa(2,il(is))
224
225 y1=xa(2,ix1(is))
226 y2=xa(2,ix2(is))
227 y3=xa(2,ix3(is))
228 y4=xa(2,ix4(is))
229 ymin = min(y1,y2,y3,y4)-gapv(is)
230 ymax = max(y1,y2,y3,y4)+gapv(is)
231 IF (ymin<=yi.AND.ymax>=yi) THEN
232 nls=nls+1
233 list(nls)=is
234 ENDIF
235 ENDDO
236C
237 DO ls=nlf,nls
238 is=list(ls)
239
240 xi=xa(1,il(is))
241
242 x1=xa(1,ix1(is))
243 x2=xa(1,ix2(is))
244 x3=xa(1,ix3(is))
245 x4=xa(1,ix4(is))
246 xmin = min(x1,x2,x3,x4)-gapv(is)
247 xmax = max(x1,x2,x3,x4)+gapv(is)
248 IF (xmin<=xi.AND.xmax>=xi) THEN
249 i=js+is
250 cand_n(i) = -cand_n(i)
251 count_cand = count_cand+1
252 ENDIF
253 ENDDO
254 ENDIF
255 IF(nspmd>1)THEN
256 nlf = nls2
257 nlt = nseg
258 IF(igap==0)THEN
259 DO ls = nlf, nlt
260 is = listi(ls)
261 gapv(is)=gap
262 ENDDO
263 ELSE
264 IF(gapmax/=zero)THEN
265 DO ls = nlf, nlt
266 is = listi(ls)
267 i=js+is
268 gapv(is)=gapfi(nin)%P(cand_n(i)-nsn)+gap_m(cand_e(i))
269 gapv(is)=min(gapv(is),gapmax)
270 gapv(is)=max(gapv(is),gap)
271 ENDDO
272 ELSE
273 DO ls = nlf, nlt
274 is = listi(ls)
275 i=js+is
276 gapv(is)=gapfi(nin)%P(cand_n(i)-nsn)+gap_m(cand_e(i))
277 gapv(is)=max(gapv(is),gap)
278 ENDDO
279 ENDIF
280 ENDIF
281 IF(icurv/=0)THEN
282 DO ls = nlf, nlt
283 is = listi(ls)
284 i=js+is
285 ii = cand_n(i)-nsn
286 l = cand_e(i)
287 IF(stf(l)/=zero.AND.stifi(nin)%P(ii)/=zero) THEN
288 xi = xfi(nin)%P(1,ii)
289 yi = xfi(nin)%P(2,ii)
290 zi = xfi(nin)%P(3,ii)
291 ix1(is)=irect(1,l)
292 ix2(is)=irect(2,l)
293 ix3(is)=irect(3,l)
294 ix4(is)=irect(4,l)
295 x1=xa(1,ix1(is))
296 x2=xa(1,ix2(is))
297 x3=xa(1,ix3(is))
298 x4=xa(1,ix4(is))
299 y1=xa(2,ix1(is))
300 y2=xa(2,ix2(is))
301 y3=xa(2,ix3(is))
302 y4=xa(2,ix4(is))
303 z1=xa(3,ix1(is))
304 z2=xa(3,ix2(is))
305 z3=xa(3,ix3(is))
306 z4=xa(3,ix4(is))
307 x0 = fourth*(x1+x2+x3+x4)
308 y0 = fourth*(y1+y2+y3+y4)
309 z0 = fourth*(z1+z2+z3+z4)
310 xxx=max(x1,x2,x3,x4)-min(x1,x2,x3,x4)
311 yyy=max(y1,y2,y3,y4)-min(y1,y2,y3,y4)
312 zzz=max(z1,z2,z3,z4)-min(z1,z2,z3,z4)
313 curv_max = half * max(xxx,yyy,zzz)
314 xmin = x0-curv_max-gapv(is)
315 ymin = y0-curv_max-gapv(is)
316 zmin = z0-curv_max-gapv(is)
317 xmax = x0+curv_max+gapv(is)
318 ymax = y0+curv_max+gapv(is)
319 zmax = z0+curv_max+gapv(is)
320 IF (xmin <= xi.AND.xmax >= xi.AND.
321 . ymin <= yi.AND.ymax >= yi.AND.
322 . zmin <= zi.AND.zmax >= zi) THEN
323 cand_n(i) = -cand_n(i)
324 count_cand = count_cand+1
325 ct = ct + 1
326 ENDIF
327 END IF
328 END DO
329 ELSE
330
331 nls=0
332 DO ls = nlf, nlt
333 is = listi(ls)
334 i=js+is
335 ii = cand_n(i)-nsn
336 l = cand_e(i)
337 IF(stf(l)/=zero.AND.stifi(nin)%P(ii)/=zero) THEN
338 zi = xfi(nin)%P(3,ii)
339 ix1(is)=irect(1,l)
340 z1=xa(3,ix1(is))
341 ix2(is)=irect(2,l)
342 z2=xa(3,ix2(is))
343 ix3(is)=irect(3,l)
344 z3=xa(3,ix3(is))
345 ix4(is)=irect(4,l)
346 z4=xa(3,ix4(is))
347 zmin = min(z1,z2,z3,z4)-gapv(is)
348 zmax = max(z1,z2,z3,z4)+gapv(is)
349 IF (zmin<=zi.AND.zmax>=zi) THEN
350 nls=nls+1
351 list(nls)=is
352 ENDIF
353 ENDIF
354 ENDDO
355C
356 nlf=1
357 nlt=nls
358 nls=0
359 DO ls=nlf,nlt
360 is=list(ls)
361 i=js+is
362 ii=cand_n(i)-nsn
363 yi=xfi(nin)%P(2,ii)
364 y1=xa(2,ix1(is))
365 y2=xa(2,ix2(is))
366 y3=xa(2,ix3(is))
367 y4=xa(2,ix4(is))
368 ymin = min(y1,y2,y3,y4)-gapv(is)
369 ymax = max(y1,y2,y3,y4)+gapv(is)
370 IF (ymin<=yi.AND.ymax>=yi) THEN
371 nls=nls+1
372 list(nls)=is
373 ENDIF
374 ENDDO
375C
376 DO ls=nlf,nls
377 is=list(ls)
378 i=js+is
379 ii = cand_n(i)-nsn
380 xi = xfi(nin)%P(1,ii)
381 x1=xa(1,ix1(is))
382 x2=xa(1,ix2(is))
383 x3=xa(1,ix3(is))
384 x4=xa(1,ix4(is))
385 xmin = min(x1,x2,x3,x4)-gapv(is)
386 xmax = max(x1,x2,x3,x4)+gapv(is)
387 IF (xmin<=xi.AND.xmax>=xi) THEN
388 cand_n(i) = -cand_n(i)
389 count_cand = count_cand+1
390 ct = ct + 1
391 ENDIF
392 ENDDO
393 END IF
394 ELSE
395 CALL sync_data(nls2)
396 ENDIF
397 js = js + nseg
398 ENDDO
399 IF (itask == 0 .AND. ifq > 0) THEN
400 DO i=1,i_stok
401 IF (ifpen(i) == 0) THEN
402 cand_fx(i) = zero
403 cand_fy(i) = zero
404 cand_fz(i) = zero
405 ENDIF
406 ifpen(i) = 0
407 ENDDO
408 ENDIF
409C
410#include "lockon.inc"
411 lskyi_count=lskyi_count+count_cand*5
412 count_remslv(nin) = count_remslv(nin)+ct
413#include "lockoff.inc"
414C
415 RETURN
416 END
417!||====================================================================
418!|| i20optcde ../engine/source/interfaces/intsort/i20optcd.F
419!||--- called by ------------------------------------------------------
420!|| i20main_opt_tri ../engine/source/interfaces/intsort/i20main_opt_tri.F
421!||--- calls -----------------------------------------------------
422!|| sync_data ../engine/source/system/machine.F
423!||--- uses -----------------------------------------------------
424!|| tri7box ../engine/share/modules/tri7box.F
425!||====================================================================
426 SUBROUTINE i20optcde(CAND_M,CAND_S ,XA ,I_STOK,
427 2 IXLINS ,IXLINM ,GAP ,NIN ,
428 3 V ,GAP_S ,GAP_M ,IGAP ,
429 4 STFS ,ITASK ,NLINSA ,STFM ,
430 5 COUNT_REMSLVE )
431C============================================================================
432C M o d u l e s
433C-----------------------------------------------
434 USE tri7box
435C-----------------------------------------------
436C I m p l i c i t T y p e s
437C-----------------------------------------------
438#include "implicit_f.inc"
439#include "comlock.inc"
440C-----------------------------------------------
441C G l o b a l P a r a m e t e r s
442C-----------------------------------------------
443#include "mvsiz_p.inc"
444C-----------------------------------------------
445C D u m m y A r g u m e n t s
446C-----------------------------------------------
447 INTEGER IXLINS(2,*),IXLINM(2,*), CAND_M(*), CAND_S(*),
448 . I_STOK, NIN,IGAP ,ITASK, NLINSA,COUNT_REMSLVE(*)
449 my_real
450 . XA(3,*),GAP,GAP_S(*),GAP_M(*),V(3,*),STFS(*), STFM(*)
451C-----------------------------------------------
452C C o m m o n B l o c k s
453C-----------------------------------------------
454#include "task_c.inc"
455#include "com01_c.inc"
456#include "param_c.inc"
457#include "parit_c.inc"
458C-----------------------------------------------
459C L o c a l V a r i a b l e s
460C-----------------------------------------------
461 INTEGER I , L, NN1, NN2
462 my_real
463 . X1,X2,X3,X4,Y1,Y2,Y3,Y4,Z1,Z2,Z3,Z4,
464 . XMINS,XMAXS,YMINS,YMAXS,ZMINS,ZMAXS,
465 . XMINM,XMAXM,YMINM,YMAXM,ZMINM,ZMAXM
466 INTEGER MSEG
467 my_real
468 . GAPV(MVSIZ)
469 INTEGER LIST(MVSIZ), LISTI(MVSIZ)
470 INTEGER IS,JS,LS,NLS,NLT,NSEG,NLF,II,NLS2
471 INTEGER N1L(MVSIZ),N2L(MVSIZ),M1L(MVSIZ),M2L(MVSIZ)
472 INTEGER SG, FIRST, LAST,COUNT_CAND,CT
473C-----------------------------------------------
474 count_cand=0
475 ct = 0
476 mseg = nvsiz
477 first = 1 + i_stok*itask / nthread
478 last = i_stok*(itask+1) / nthread
479 js = first-1
480 DO sg = first,last,mseg
481 nseg = min(mseg,last-js)
482 nls=0
483 IF(nspmd>1) THEN
484C
485C Partage cand_n local / frontiere
486C
487 nls = 0
488 nls2 = nseg+1
489 DO is = 1, nseg
490 i=js+is
491 IF(cand_s(i)<=nlinsa)THEN
492 nls=nls+1
493 listi(nls)=is
494 ELSE
495 nls2=nls2-1
496 listi(nls2) = is
497 ENDIF
498 ENDDO
499 IF(igap==0)THEN
500 DO ls = 1, nls
501 is = listi(ls)
502 gapv(is)=gap
503 ENDDO
504 ELSE
505 DO ls = 1, nls
506 is = listi(ls)
507 i=js+is
508 gapv(is)=gap_s(cand_s(i))+gap_m(cand_m(i))
509 gapv(is)=max(gapv(is),gap)
510 ENDDO
511 ENDIF
512 ELSE
513 nls = nseg
514 IF(igap==0)THEN
515 DO is=1,nseg
516 gapv(is)=gap
517 listi(is)=is
518 ENDDO
519 ELSE
520 DO is=1,nseg
521 i=js+is
522 gapv(is)=gap_s(cand_s(i))+gap_m(cand_m(i))
523 gapv(is)=max(gapv(is),gap)
524 listi(is)=is
525 ENDDO
526 ENDIF
527 ENDIF
528C
529 nlf = 1
530 nlt = nls
531 nls=0
532 DO ls = nlf, nlt
533 is = listi(ls)
534 i=js+is
535 l = cand_s(i)
536 IF (stfs(l)/=zero) THEN
537 n1l(is)=ixlins(1,l)
538 z1=xa(3,n1l(is))
539 n2l(is)=ixlins(2,l)
540 z2=xa(3,n2l(is))
541 l = cand_m(i)
542 IF (stfm(l)/=zero) THEN
543
544 m1l(is)=ixlinm(1,l)
545 z3=xa(3,m1l(is))
546 m2l(is)=ixlinm(2,l)
547 z4=xa(3,m2l(is))
548 zmins = min(z1,z2)-gapv(is)
549 zmaxs = max(z1,z2)+gapv(is)
550 zminm = min(z3,z4)-gapv(is)
551 zmaxm = max(z3,z4)+gapv(is)
552 IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
553 nls=nls+1
554 list(nls)=is
555 ENDIF
556 ENDIF
557 ENDIF
558 ENDDO
559C
560 nlt=nls
561 nls=0
562 DO ls=nlf,nlt
563 is=list(ls)
564 i=js+is
565 l = cand_s(i)
566 n1l(is)=ixlins(1,l)
567 y1=xa(2,n1l(is))
568 n2l(is)=ixlins(2,l)
569 y2=xa(2,n2l(is))
570 l = cand_m(i)
571 m1l(is)=ixlinm(1,l)
572 y3=xa(2,m1l(is))
573 m2l(is)=ixlinm(2,l)
574 y4=xa(2,m2l(is))
575 ymins = min(y1,y2)-gapv(is)
576 ymaxs = max(y1,y2)+gapv(is)
577 yminm = min(y3,y4)-gapv(is)
578 ymaxm = max(y3,y4)+gapv(is)
579 IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
580 nls=nls+1
581 list(nls)=is
582 ENDIF
583 ENDDO
584C
585 DO ls=nlf,nls
586 is=list(ls)
587 i=js+is
588 l = cand_s(i)
589 n1l(is)=ixlins(1,l)
590 x1=xa(1,n1l(is))
591 n2l(is)=ixlins(2,l)
592 x2=xa(1,n2l(is))
593 l = cand_m(i)
594 m1l(is)=ixlinm(1,l)
595 x3=xa(1,m1l(is))
596 m2l(is)=ixlinm(2,l)
597 x4=xa(1,m2l(is))
598 xmins = min(x1,x2)-gapv(is)
599 xmaxs = max(x1,x2)+gapv(is)
600 xminm = min(x3,x4)-gapv(is)
601 xmaxm = max(x3,x4)+gapv(is)
602 IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
603 cand_s(i) = -cand_s(i)
604 count_cand = count_cand+1
605 ENDIF
606 ENDDO
607C
608 IF(nspmd>1)THEN
609 nlf = nls2
610 nlt = nseg
611 IF(igap==0)THEN
612 DO ls=nlf, nlt
613 is = listi(ls)
614 gapv(is)=gap
615 ENDDO
616 ELSE
617 DO ls = nlf, nlt
618 is = listi(ls)
619 i=js+is
620 gapv(is)=gapfie(nin)%P(cand_s(i)-nlinsa)+gap_m(cand_m(i))
621 gapv(is)=max(gapv(is),gap)
622 ENDDO
623 ENDIF
624C
625 nls=0
626 DO ls = nlf, nlt
627C keep LISTI and LIST to optimize generated code (IA64)
628 is = listi(ls)
629 i=js+is
630 ii = cand_s(i)-nlinsa
631 IF (stifie(nin)%P(ii)/=zero) THEN
632 nn1 = 2*(ii-1)+1
633 nn2 = 2*ii
634 z1=xfie(nin)%P(3,nn1)
635 z2=xfie(nin)%P(3,nn2)
636 l = cand_m(i)
637 IF (stfm(l)/=zero) THEN
638 m1l(is)=ixlinm(1,l)
639 z3=xa(3,m1l(is))
640 m2l(is)=ixlinm(2,l)
641 z4=xa(3,m2l(is))
642 zmins = min(z1,z2)-gapv(is)
643 zmaxs = max(z1,z2)+gapv(is)
644 zminm = min(z3,z4)-gapv(is)
645 zmaxm = max(z3,z4)+gapv(is)
646 IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
647 nls=nls+1
648 list(nls)=is
649 ENDIF
650 ENDIF
651 ENDIF
652 ENDDO
653C
654 nlf=1
655 nlt=nls
656 nls=0
657 DO ls=nlf,nlt
658 is=list(ls)
659 i=js+is
660 ii = cand_s(i)-nlinsa
661 nn1 = 2*(ii-1)+1
662 nn2 = 2*ii
663 y1=xfie(nin)%P(2,nn1)
664 y2=xfie(nin)%P(2,nn2)
665 l = cand_m(i)
666 m1l(is)=ixlinm(1,l)
667 y3=xa(2,m1l(is))
668 m2l(is)=ixlinm(2,l)
669 y4=xa(2,m2l(is))
670 ymins = min(y1,y2)-gapv(is)
671 ymaxs = max(y1,y2)+gapv(is)
672 yminm = min(y3,y4)-gapv(is)
673 ymaxm = max(y3,y4)+gapv(is)
674 IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
675 nls=nls+1
676 list(nls)=is
677 ENDIF
678 ENDDO
679C
680 DO ls=nlf,nls
681 is=list(ls)
682 i=js+is
683 ii = cand_s(i)-nlinsa
684 nn1 = 2*(ii-1)+1
685 nn2 = 2*ii
686 x1=xfie(nin)%P(1,nn1)
687 x2=xfie(nin)%P(1,nn2)
688 l = cand_m(i)
689 m1l(is)=ixlinm(1,l)
690 x3=xa(1,m1l(is))
691 m2l(is)=ixlinm(2,l)
692 x4=xa(1,m2l(is))
693 xmins = min(x1,x2)-gapv(is)
694 xmaxs = max(x1,x2)+gapv(is)
695 xminm = min(x3,x4)-gapv(is)
696 xmaxm = max(x3,x4)+gapv(is)
697 IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
698 cand_s(i) = -cand_s(i)
699 count_cand = count_cand+1
700 ct = ct + 1
701 ENDIF
702 ENDDO
703 CALL sync_data(nls2)
704 END IF
705 js = js + nseg
706 ENDDO
707C
708#include "lockon.inc"
709 lskyi_count=lskyi_count+count_cand*5
710 count_remslve(nin) = count_remslve(nin) + ct
711#include "lockoff.inc"
712
713C
714 RETURN
715 END
716
sync_data
subroutine sync_data(ii)
Definition machine.F:383
i20optcde
subroutine i20optcde(cand_m, cand_s, xa, i_stok, ixlins, ixlinm, gap, nin, v, gap_s, gap_m, igap, stfs, itask, nlinsa, stfm, count_remslve)
Definition i20optcd.F:431
i20optcd
subroutine i20optcd(nsv, cand_e, cand_n, xa, i_stok, irect, gap, gap_s, gap_m, igap, stfa, itask, stf, ifq, ifpen, cand_fx, cand_fy, cand_fz, nin, nsn, gapmax, icurv, count_remslv)
Definition i20optcd.F:37
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
tri7box::gapfie
type(real_pointer), dimension(:), allocatable gapfie
Definition tri7box.F:449
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::xfie
type(real_pointer2), dimension(:), allocatable xfie
Definition tri7box.F:459
tri7box::stifie
type(real_pointer), dimension(:), allocatable stifie
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