OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20optcd.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 "vectorize.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

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)
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)

Function/Subroutine Documentation

◆ i20optcd()

subroutine i20optcd ( integer, dimension(*) nsv,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
xa,
integer i_stok,
integer, dimension(4,*) irect,
gap,
gap_s,
gap_m,
integer igap,
stfa,
integer itask,
stf,
integer ifq,
integer, dimension(*) ifpen,
cand_fx,
cand_fy,
cand_fz,
integer nin,
integer nsn,
gapmax,
integer icurv,
integer, dimension(*) count_remslv )

Definition at line 32 of file i20optcd.F.

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),IG(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,v12,v22,v32,v42
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 conserver LISTI et LIST pour optimiser le code genere (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
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

◆ i20optcde()

subroutine i20optcde ( integer, dimension(*) cand_m,
integer, dimension(*) cand_s,
xa,
integer i_stok,
integer, dimension(2,*) ixlins,
integer, dimension(2,*) ixlinm,
gap,
integer nin,
v,
gap_s,
gap_m,
integer igap,
stfs,
integer itask,
integer nlinsa,
stfm,
integer, dimension(*) count_remslve )

Definition at line 426 of file i20optcd.F.

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 . xi,x1,x2,x3,x4,yi,y1,y2,y3,y4,zi,z1,z2,z3,z4,
464 . xmins,xmaxs,ymins,ymaxs,zmins,zmaxs,
465 . xminm,xmaxm,yminm,ymaxm,zminm,zmaxm,
466 . v12,v22,v32,v42,vv
467 INTEGER MSEG
468 my_real
469 . gapv(mvsiz),dtti(mvsiz)
470 INTEGER LIST(MVSIZ), LISTI(MVSIZ)
471 INTEGER IS,JS,LS,NLS,NLT,NSEG,NLF,II,NLS2
472 INTEGER N1L(MVSIZ),N2L(MVSIZ),M1L(MVSIZ),M2L(MVSIZ)
473 INTEGER SG, FIRST, LAST,COUNT_CAND,CT
474C-----------------------------------------------
475 count_cand=0
476 ct = 0
477 mseg = nvsiz
478 first = 1 + i_stok*itask / nthread
479 last = i_stok*(itask+1) / nthread
480 js = first-1
481 DO sg = first,last,mseg
482 nseg = min(mseg,last-js)
483 nls=0
484 IF(nspmd>1) THEN
485C
486C Partage cand_n local / frontiere
487C
488 nls = 0
489 nls2 = nseg+1
490 DO is = 1, nseg
491 i=js+is
492 IF(cand_s(i)<=nlinsa)THEN
493 nls=nls+1
494 listi(nls)=is
495 ELSE
496 nls2=nls2-1
497 listi(nls2) = is
498 ENDIF
499 ENDDO
500 IF(igap==0)THEN
501 DO ls = 1, nls
502 is = listi(ls)
503 gapv(is)=gap
504 ENDDO
505 ELSE
506 DO ls = 1, nls
507 is = listi(ls)
508 i=js+is
509 gapv(is)=gap_s(cand_s(i))+gap_m(cand_m(i))
510 gapv(is)=max(gapv(is),gap)
511 ENDDO
512 ENDIF
513 ELSE
514 nls = nseg
515 IF(igap==0)THEN
516 DO is=1,nseg
517 gapv(is)=gap
518 listi(is)=is
519 ENDDO
520 ELSE
521 DO is=1,nseg
522 i=js+is
523 gapv(is)=gap_s(cand_s(i))+gap_m(cand_m(i))
524 gapv(is)=max(gapv(is),gap)
525 listi(is)=is
526 ENDDO
527 ENDIF
528 ENDIF
529C
530 nlf = 1
531 nlt = nls
532 nls=0
533 DO ls = nlf, nlt
534 is = listi(ls)
535 i=js+is
536 l = cand_s(i)
537 IF (stfs(l)/=zero) THEN
538 n1l(is)=ixlins(1,l)
539 z1=xa(3,n1l(is))
540 n2l(is)=ixlins(2,l)
541 z2=xa(3,n2l(is))
542 l = cand_m(i)
543 IF (stfm(l)/=zero) THEN
544
545 m1l(is)=ixlinm(1,l)
546 z3=xa(3,m1l(is))
547 m2l(is)=ixlinm(2,l)
548 z4=xa(3,m2l(is))
549 zmins = min(z1,z2)-gapv(is)
550 zmaxs = max(z1,z2)+gapv(is)
551 zminm = min(z3,z4)-gapv(is)
552 zmaxm = max(z3,z4)+gapv(is)
553 IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
554 nls=nls+1
555 list(nls)=is
556 ENDIF
557 ENDIF
558 ENDIF
559 ENDDO
560C
561 nlt=nls
562 nls=0
563 DO ls=nlf,nlt
564 is=list(ls)
565 i=js+is
566 l = cand_s(i)
567 n1l(is)=ixlins(1,l)
568 y1=xa(2,n1l(is))
569 n2l(is)=ixlins(2,l)
570 y2=xa(2,n2l(is))
571 l = cand_m(i)
572 m1l(is)=ixlinm(1,l)
573 y3=xa(2,m1l(is))
574 m2l(is)=ixlinm(2,l)
575 y4=xa(2,m2l(is))
576 ymins = min(y1,y2)-gapv(is)
577 ymaxs = max(y1,y2)+gapv(is)
578 yminm = min(y3,y4)-gapv(is)
579 ymaxm = max(y3,y4)+gapv(is)
580 IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
581 nls=nls+1
582 list(nls)=is
583 ENDIF
584 ENDDO
585C
586 DO ls=nlf,nls
587 is=list(ls)
588 i=js+is
589 l = cand_s(i)
590 n1l(is)=ixlins(1,l)
591 x1=xa(1,n1l(is))
592 n2l(is)=ixlins(2,l)
593 x2=xa(1,n2l(is))
594 l = cand_m(i)
595 m1l(is)=ixlinm(1,l)
596 x3=xa(1,m1l(is))
597 m2l(is)=ixlinm(2,l)
598 x4=xa(1,m2l(is))
599 xmins = min(x1,x2)-gapv(is)
600 xmaxs = max(x1,x2)+gapv(is)
601 xminm = min(x3,x4)-gapv(is)
602 xmaxm = max(x3,x4)+gapv(is)
603 IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
604 cand_s(i) = -cand_s(i)
605 count_cand = count_cand+1
606 ENDIF
607 ENDDO
608C
609 IF(nspmd>1)THEN
610 nlf = nls2
611 nlt = nseg
612 IF(igap==0)THEN
613 DO ls=nlf, nlt
614 is = listi(ls)
615 gapv(is)=gap
616 ENDDO
617 ELSE
618 DO ls = nlf, nlt
619 is = listi(ls)
620 i=js+is
621 gapv(is)=gapfie(nin)%P(cand_s(i)-nlinsa)+gap_m(cand_m(i))
622 gapv(is)=max(gapv(is),gap)
623 ENDDO
624 ENDIF
625C
626 nls=0
627 DO ls = nlf, nlt
628C conserver LISTI et LIST pour optimiser le code genere (IA64)
629 is = listi(ls)
630 i=js+is
631 ii = cand_s(i)-nlinsa
632 IF (stifie(nin)%P(ii)/=zero) THEN
633 nn1 = 2*(ii-1)+1
634 nn2 = 2*ii
635 z1=xfie(nin)%P(3,nn1)
636 z2=xfie(nin)%P(3,nn2)
637 l = cand_m(i)
638 IF (stfm(l)/=zero) THEN
639 m1l(is)=ixlinm(1,l)
640 z3=xa(3,m1l(is))
641 m2l(is)=ixlinm(2,l)
642 z4=xa(3,m2l(is))
643 zmins = min(z1,z2)-gapv(is)
644 zmaxs = max(z1,z2)+gapv(is)
645 zminm = min(z3,z4)-gapv(is)
646 zmaxm = max(z3,z4)+gapv(is)
647 IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
648 nls=nls+1
649 list(nls)=is
650 ENDIF
651 ENDIF
652 ENDIF
653 ENDDO
654C
655 nlf=1
656 nlt=nls
657 nls=0
658 DO ls=nlf,nlt
659 is=list(ls)
660 i=js+is
661 ii = cand_s(i)-nlinsa
662 nn1 = 2*(ii-1)+1
663 nn2 = 2*ii
664 y1=xfie(nin)%P(2,nn1)
665 y2=xfie(nin)%P(2,nn2)
666 l = cand_m(i)
667 m1l(is)=ixlinm(1,l)
668 y3=xa(2,m1l(is))
669 m2l(is)=ixlinm(2,l)
670 y4=xa(2,m2l(is))
671 ymins = min(y1,y2)-gapv(is)
672 ymaxs = max(y1,y2)+gapv(is)
673 yminm = min(y3,y4)-gapv(is)
674 ymaxm = max(y3,y4)+gapv(is)
675 IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
676 nls=nls+1
677 list(nls)=is
678 ENDIF
679 ENDDO
680C
681 DO ls=nlf,nls
682 is=list(ls)
683 i=js+is
684 ii = cand_s(i)-nlinsa
685 nn1 = 2*(ii-1)+1
686 nn2 = 2*ii
687 x1=xfie(nin)%P(1,nn1)
688 x2=xfie(nin)%P(1,nn2)
689 l = cand_m(i)
690 m1l(is)=ixlinm(1,l)
691 x3=xa(1,m1l(is))
692 m2l(is)=ixlinm(2,l)
693 x4=xa(1,m2l(is))
694 xmins = min(x1,x2)-gapv(is)
695 xmaxs = max(x1,x2)+gapv(is)
696 xminm = min(x3,x4)-gapv(is)
697 xmaxm = max(x3,x4)+gapv(is)
698 IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
699 cand_s(i) = -cand_s(i)
700 count_cand = count_cand+1
701 ct = ct + 1
702 ENDIF
703 ENDDO
704 CALL sync_data(nls2)
705 END IF
706 js = js + nseg
707 ENDDO
708C
709#include "lockon.inc"
710 lskyi_count=lskyi_count+count_cand*5
711 count_remslve(nin) = count_remslve(nin) + ct
712#include "lockoff.inc"
713
714C
715 RETURN
tri7box::gapfie
type(real_pointer), dimension(:), allocatable gapfie
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