OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25optcd_e2s.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!|| i25optcd_e2s ../engine/source/interfaces/intsort/i25optcd_e2s.F
25!||--- called by ------------------------------------------------------
26!|| i25main_opt_tri ../engine/source/interfaces/intsort/i25main_opt_tri.f
27!||--- calls -----------------------------------------------------
28!|| int_checksum ../engine/share/modules/debug_mod.F
29!|| my_barrier ../engine/source/system/machine.F
30!|| sync_data ../engine/source/system/machine.F
31!||--- uses -----------------------------------------------------
32!|| debug_mod ../engine/share/modules/debug_mod.F
33!|| tri25ebox ../engine/share/modules/tri25ebox.F
34!|| tri7box ../engine/share/modules/tri7box.f
35!||====================================================================
36 SUBROUTINE i25optcd_e2s(CAND_M,CAND_S,X ,I_STOK,IRECT ,
37 2 NIN ,V ,GAP_M,IGAP ,ITASK ,
38 3 STF ,GAP_M_L,COUNT_REMSLVE,DRAD ,
39 4 IEDGE ,NEDGE ,LEDGE ,MVOISIN,NSV,
40 5 NRTM ,GAPE ,GAP_E_L,IGAP0,
41 6 STFE, S_STFE ,IFQ ,IFPEN,
42 7 CAND_FX,CAND_FY,CAND_FZ,DGAPLOAD)
43C============================================================================
44C M o d u l e s
45C-----------------------------------------------
46 USE tri7box
47 USE tri25ebox
48#ifdef with_assert
49 USE debug_mod
50#endif
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55#include "comlock.inc"
56C-----------------------------------------------
57C G l o b a l P a r a m e t e r s
58C-----------------------------------------------
59#include "mvsiz_p.inc"
60#include "assert.inc"
61#include "i25edge_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER, INTENT(IN) :: S_STFE
66 INTEGER IRECT(4,*),CAND_M(*), CAND_S(*), IFPEN(*),
67 . I_STOK, NIN,IGAP ,ITASK, COUNT_REMSLVE(*),
68 . IEDGE, NEDGE, LEDGE(NLEDGE,*), MVOISIN(4,*), NSV(*), NRTM, IGAP0,IFQ
69 my_real , INTENT(IN) :: DGAPLOAD ,DRAD
70 my_real
71 . x(3,*),gap_m(*),v(3,*),stf(*),gap_m_l(*), gape(*), gap_e_l(*),
72 . stfe(s_stfe), cand_fx(4,*),cand_fy(4,*),cand_fz(4,*)
73
74C-----------------------------------------------
75C C o m m o n B l o c k s
76C-----------------------------------------------
77#include "task_c.inc"
78#include "com01_c.inc"
79#include "param_c.inc"
80#include "parit_c.inc"
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER I , L, M, E, IE, JE, NN1, NN2, IL, JL, I1, I2, SOL_EDGE, SH_EDGE,
85 . NRTMFT, NRTMLT
86 my_real
87 . XI,YI,ZI,X1S,X2S,Y1S,Y2S,Z1S,Z2S,
88 . X1,X2,X3,X4,
89 . Y1,Y2,Y3,Y4,
90 . z1,z2,z3,z4,
91 . x5,x6,x7,x8,
92 . y5,y6,y7,y8,
93 . z5,z6,z7,z8,
94 . xmins,xmaxs,ymins,ymaxs,zmins,zmaxs,
95 . xminm,xmaxm,yminm,ymaxm,zminm,zmaxm,
96 . xminm_1,xmaxm_1,yminm_1,ymaxm_1,zminm_1,zmaxm_1,
97 . xminm_2,xmaxm_2,yminm_2,ymaxm_2,zminm_2,zmaxm_2,dxm,dym,dzm,
98 . v12,v22,v32,v42,vv,gapvd,s
99 INTEGER MSEG,CT
100 my_real
101 . GAPV(MVSIZ),DTTI(MVSIZ)
102 INTEGER LIST(MVSIZ), LISTI(MVSIZ)
103 INTEGER IS,JS,LS,NLS,NLT,NSEG,NLF,II,NLS2,NLSAV
104 INTEGER N1(MVSIZ),N2(MVSIZ),M1(MVSIZ),M2(MVSIZ)
105 INTEGER SG, FIRST, LAST,COUNT_CAND
106 INTEGER, DIMENSION(:),ALLOCATABLE :: TAGM
107 my_real,
108 . DIMENSION(:,:),ALLOCATABLE :: boxm
109 SAVE tagm,boxm
110 INTEGER :: IDS(4)
111 INTEGER :: J
112 INTEGER :: MY_SIZE
113 INTEGER, DIMENSION(:), ALLOCATABLE :: LIST_REAL_CANDIDATE
114
115C-----------------------------------------------
116 sol_edge=iedge/10 ! solids
117 sh_edge =iedge-10*sol_edge ! shells
118C-----------------------------------------------
119 count_cand = 0
120 ct = 0
121 mseg = nvsiz
122 first = 1 + i_stok*itask / nthread
123 last = i_stok*(itask+1) / nthread
124 my_size = last - first + 1
125 ALLOCATE( list_real_candidate(my_size) )
126C-----------------------------------------------
127 IF(sol_edge/=0)THEN
128
129 IF(itask==0)THEN
130 ALLOCATE(tagm(nrtm),boxm(6,nrtm))
131 tagm(1:nrtm)=0
132 END IF
133
134 CALL my_barrier
135
136 DO i=first,last
137 l = cand_m(i)
138 IF(stf(l)/=zero)tagm(l)=1
139 END DO
140
141 CALL my_barrier
142
143 nrtmft=1 + nrtm*itask / nthread
144 nrtmlt=nrtm*(itask+1) / nthread
145
146 DO l=nrtmft,nrtmlt
147
148 boxm(1,l)= ep30
149 boxm(2,l)=-ep30
150 boxm(3,l)= ep30
151 boxm(4,l)=-ep30
152 boxm(5,l)= ep30
153 boxm(6,l)=-ep30
154
155 IF(tagm(l)/=0)THEN
156
157 x1=x(1,irect(1,l))
158 y1=x(2,irect(1,l))
159 z1=x(3,irect(1,l))
160 x2=x(1,irect(2,l))
161 y2=x(2,irect(2,l))
162 z2=x(3,irect(2,l))
163 x3=x(1,irect(3,l))
164 y3=x(2,irect(3,l))
165 z3=x(3,irect(3,l))
166 x4=x(1,irect(4,l))
167 y4=x(2,irect(4,l))
168 z4=x(3,irect(4,l))
169
170 xminm = min(x1,x2,x3,x4)
171 xmaxm = max(x1,x2,x3,x4)
172 dxm = em02*(xmaxm-xminm)
173 xminm = xminm-dxm
174 xmaxm = xmaxm+dxm
175
176 yminm = min(y1,y2,y3,y4)
177 ymaxm = max(y1,y2,y3,y4)
178 dym = em02*(ymaxm-yminm)
179 yminm = yminm-dym
180 ymaxm = ymaxm+dym
181
182 zminm = min(z1,z2,z3,z4)
183 zmaxm = max(z1,z2,z3,z4)
184 dzm = em02*(zmaxm-zminm)
185 zminm = zminm-dzm
186 zmaxm = zmaxm+dzm
187
188 boxm(1,l)=xminm
189 boxm(2,l)=xmaxm
190 boxm(3,l)=yminm
191 boxm(4,l)=ymaxm
192 boxm(5,l)=zminm
193 boxm(6,l)=zmaxm
194
195 END IF
196 END DO
197
198 CALL my_barrier
199
200 END IF ! IF(SOL_EDGE/0)THEN
201C-----
202 js = first-1
203 DO sg = first,last,mseg
204 nseg = min(mseg,last-js)
205C-----------------------------------------------
206C solid edges on main side
207C-----------------------------------------------
208 IF(nspmd>1) THEN
209C
210C Partage cand_n local / frontiere
211C
212 nls = 0
213 nls2 = nseg+1
214 DO is = 1, nseg
215 i=js+is
216 IF(cand_s(i)<=nedge)THEN
217
218 IF(sh_edge==1.AND.
219 . ledge(7,cand_s(i))/=1.AND.
220 . ledge(3,cand_s(i))/=0) cycle ! Shell edge is not a free edge
221 nls=nls+1
222 listi(nls)=is
223
224#ifdef WITH_ASSERT
225C Debug only
226 ids(1) = itab_debug(irect(1,cand_m(i)))
227 ids(2) = itab_debug(irect(2,cand_m(i)))
228 ids(3) = itab_debug(irect(3,cand_m(i)))
229 ids(4) = itab_debug(irect(4,cand_m(i)))
230 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,i)
231#endif
232
233 ELSE ! REMOTE
234 IF(sh_edge==1.AND.
235 . ledge_fie(nin)%P(e_type,cand_s(i)-nedge)/=1.AND.
236 . ledge_fie(nin)%P(e_right_seg,cand_s(i)-nedge)/=0) cycle ! Shell edge is not a free edge
237 nls2=nls2-1
238 assert(is <= mvsiz)
239 assert(is > 0)
240 listi(nls2) = is
241#ifdef WITH_ASSERT
242C Debug only
243 ids(1) = itab_debug(irect(1,cand_m(i)))
244 ids(2) = itab_debug(irect(2,cand_m(i)))
245 ids(3) = itab_debug(irect(3,cand_m(i)))
246 ids(4) = itab_debug(irect(4,cand_m(i)))
247 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge),i)
248#endif
249 ENDIF
250 ENDDO
251C LISTI(1:NLS) = Local
252C LISTI(NLS+1:NSEG) = REMOTE
253
254CC LOCAL OF SPMD
255C#include "vectorize.inc"
256C DO LS = 1, NLS
257C IS = LISTI(LS)
258C I=JS+IS
259C IE=CAND_M(I) ! segment, zero gap
260C JE=CAND_S(I) ! edge
261C GAPV(IS)=GAPE(JE)
262C IF(SH_EDGE /= 0 .AND. IGAP0 /= 0) GAPV(IS)=TWO*GAPV(IS)
263C IF(IGAP==3)
264C . GAPV(IS)=MIN(GAPV(IS),GAP_M_L(IE)+GAP_E_L(JE))
265C GAPV(IS)=MAX(GAPV(IS),DRAD)
266C ENDDO
267
268 ELSE ! NSPMD == 1
269 nls = 0
270C Build LISTI
271 DO is=1,nseg
272 i=js+is
273 IF(sh_edge==1.AND.
274 . ledge(7,cand_s(i))/=1.AND.
275 . ledge(3,cand_s(i))/=0) cycle ! Shell edge is not a free edge
276
277
278#ifdef WITH_ASSERT
279 ids(1) = itab_debug(irect(1,cand_m(i)))
280 ids(2) = itab_debug(irect(2,cand_m(i)))
281 ids(3) = itab_debug(irect(3,cand_m(i)))
282 ids(4) = itab_debug(irect(4,cand_m(i)))
283 debug_e2e(int_checksum(ids,4,1)==d_em.AND.ledge(8,cand_s(i)) == d_es,i)
284#endif
285
286 nls=nls+1
287 listi(nls)=is
288 ENDDO
289 ENDIF ! END IF SPMD
290
291
292C========== LOCAL
293#include "vectorize.inc"
294 DO ls = 1, nls
295 is = listi(ls)
296 i=js+is
297 ie=cand_m(i) ! segment, zero gap
298 je=cand_s(i) ! edge
299 gapv(is)=gape(je)
300 IF(sh_edge /= 0 .AND. igap0 /= 0) gapv(is)=two*gapv(is)
301 IF(igap==3)
302 . gapv(is)=min(gapv(is),gap_m_l(ie)+gap_e_l(je))
303 gapv(is)=max(gapv(is)+dgapload,drad)
304 ENDDO
305
306C
307 nlf = 1
308 nlt = nls
309 nls = 0
310C ======== LOCAL TIRM 1
311 DO ls = nlf, nlt
312 is = listi(ls)
313 i = js + is
314C LEDGE(1) can be < 0 if:
315C - the edge it on a boundary between two domains
316C - The logal segment is broken
317 l = ledge(1,cand_s(i))
318 s = zero
319#ifdef WITH_ASSERT
320 ids(1) = itab_debug(irect(1,cand_m(i)))
321 ids(2) = itab_debug(irect(2,cand_m(i)))
322 ids(3) = itab_debug(irect(3,cand_m(i)))
323 ids(4) = itab_debug(irect(4,cand_m(i)))
324 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,l)
325 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,ledge(ledge_weight,cand_s(i)))
326#endif
327
328 IF( l > 0 ) THEN
329 s = stfe(cand_s(i))
330 ELSEIF (l < 0) THEN
331C Boundary edge, owned by ISPMD, but local segment broken
332C In that case, we assume that the segment on the
333C other side of the boundary is not broken
334 s = one
335C S = ZERO
336 ENDIF
337
338#ifdef WITH_ASSERT
339 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,s)
340#endif
341
342 IF (s/=zero) THEN
343 n1(is)= ledge(5,cand_s(i))
344 n2(is)= ledge(6,cand_s(i))
345 z1s=x(3,n1(is))
346 z2s=x(3,n2(is))
347 gapvd = gapv(is)
348 zmins = min(z1s,z2s)-gapvd
349 zmaxs = max(z1s,z2s)+gapvd
350 zminm = boxm(5,cand_m(i))
351 zmaxm = boxm(6,cand_m(i))
352 zminm = zminm-gapvd
353 zmaxm = zmaxm+gapvd
354#ifdef WITH_ASSERT
355 ids(1) = itab_debug(irect(1,cand_m(i)))
356 ids(2) = itab_debug(irect(2,cand_m(i)))
357 ids(3) = itab_debug(irect(3,cand_m(i)))
358 ids(4) = itab_debug(irect(4,cand_m(i)))
359 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,zmaxs)
360 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,zmins)
361 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,zmaxm)
362 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,zminm)
363#endif
364
365 IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
366 nls=nls+1
367 list(nls)=is
368 ENDIF
369 ENDIF
370 ENDDO
371C
372 nlt=nls
373 nls=0
374C ======== LOCAL TIRM 2
375 DO ls=nlf,nlt
376 is=list(ls)
377 i=js+is
378 y1s=x(2,n1(is))
379 y2s=x(2,n2(is))
380 gapvd = gapv(is)
381 ymins = min(y1s,y2s)-gapvd
382 ymaxs = max(y1s,y2s)+gapvd
383 yminm = boxm(3,cand_m(i))
384 ymaxm = boxm(4,cand_m(i))
385 yminm = yminm-gapvd
386 ymaxm = ymaxm+gapvd
387#ifdef WITH_ASSERT
388 ids(1) = itab_debug(irect(1,cand_m(i)))
389 ids(2) = itab_debug(irect(2,cand_m(i)))
390 ids(3) = itab_debug(irect(3,cand_m(i)))
391 ids(4) = itab_debug(irect(4,cand_m(i)))
392 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,ymaxs)
393 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,ymins)
394 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,ymaxm)
395 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,yminm)
396#endif
397
398 IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
399 nls=nls+1
400 list(nls)=is
401 ENDIF
402 ENDDO
403C
404 nlt = nls
405 nls=0
406C ======== LOCAL TIRM 3
407 DO ls=nlf,nlt
408 is=list(ls)
409 i=js+is
410 x1s=x(1,n1(is))
411 x2s=x(1,n2(is))
412 gapvd = gapv(is)
413 xmins = min(x1s,x2s)-gapvd
414 xmaxs = max(x1s,x2s)+gapvd
415 xminm = boxm(1,cand_m(i))
416 xmaxm = boxm(2,cand_m(i))
417 xminm = xminm-gapvd
418 xmaxm = xmaxm+gapvd
419#ifdef WITH_ASSERT
420 ids(1) = itab_debug(irect(1,cand_m(i)))
421 ids(2) = itab_debug(irect(2,cand_m(i)))
422 ids(3) = itab_debug(irect(3,cand_m(i)))
423 ids(4) = itab_debug(irect(4,cand_m(i)))
424 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,xmaxs)
425 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,xmins)
426 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,xmaxm)
427 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge(8,cand_s(i)) == d_es,xminm)
428#endif
429
430 IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
431 cand_s(i) = -cand_s(i)
432 count_cand = count_cand+1
433 list_real_candidate(count_cand) = i
434 ENDIF
435 ENDDO
436C
437 IF(nspmd>1)THEN
438 nlf = nls2
439 nlt = nseg
440C ========= REMOTE
441 DO ls = nlf, nlt
442 is = listi(ls)
443 i=js+is
444 ie=cand_m(i)
445 gapv(is)=gapfie(nin)%P(cand_s(i)-nedge)
446 IF(sh_edge /= 0 .AND. igap0 /= 0) gapv(is)=two*gapv(is)
447
448 IF(igap==3)
449 . gapv(is)=min(gapv(is),gape_l_fie(nin)%P(cand_s(i)-nedge)+gap_m_l(ie))
450 gapv(is)=max(gapv(is)+dgapload,drad)
451 ENDDO
452C
453 nls=0
454C ========= REMOTE TRIM 1
455 DO ls = nlf, nlt
456C conserver LISTI et LIST pour optimiser le code genere (IA64)
457 is = listi(ls)
458 i=js+is
459 ii = cand_s(i)-nedge
460#ifdef WITH_ASSERT
461 ids(1) = itab_debug(irect(1,cand_m(i)))
462 ids(2) = itab_debug(irect(2,cand_m(i)))
463 ids(3) = itab_debug(irect(3,cand_m(i)))
464 ids(4) = itab_debug(irect(4,cand_m(i)))
465 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,stifie(nin)%P(ii))
466#endif
467
468 IF (stifie(nin)%P(ii)/=zero) THEN
469 nn1 = 2*(ii-1)+1
470 nn2 = 2*ii
471 z1s=xfie(nin)%P(3,nn1)
472 z2s=xfie(nin)%P(3,nn2)
473C L = LEDGE(1,CAND_M(I))
474C IF (STF(L)/=ZERO) THEN
475 gapvd = gapv(is)
476 zmins = min(z1s,z2s)-gapvd
477 zmaxs = max(z1s,z2s)+gapvd
478 zminm = boxm(5,cand_m(i))
479 zmaxm = boxm(6,cand_m(i))
480 zminm = zminm-gapvd
481 zmaxm = zmaxm+gapvd
482#ifdef WITH_ASSERT
483 ids(1) = itab_debug(irect(1,cand_m(i)))
484 ids(2) = itab_debug(irect(2,cand_m(i)))
485 ids(3) = itab_debug(irect(3,cand_m(i)))
486 ids(4) = itab_debug(irect(4,cand_m(i)))
487 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,zmaxs)
488 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,zmins)
489 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,zmaxm)
490 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,zminm)
491#endif
492
493 IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
494 nls=nls+1
495 list(nls)=is
496 ENDIF
497C ENDIF
498 ENDIF
499 ENDDO
500C
501 nlf=1
502 nlt=nls
503 nls=0
504C ============= REMOTE TRIM 2
505 DO ls=nlf,nlt
506 is=list(ls)
507 i=js+is
508 ii = cand_s(i)-nedge
509 nn1 = 2*(ii-1)+1
510 nn2 = 2*ii
511 y1s=xfie(nin)%P(2,nn1)
512 y2s=xfie(nin)%P(2,nn2)
513
514
515 gapvd = gapv(is)
516 ymins = min(y1s,y2s)-gapvd
517 ymaxs = max(y1s,y2s)+gapvd
518 yminm = boxm(3,cand_m(i))
519 ymaxm = boxm(4,cand_m(i))
520 yminm = yminm-gapvd
521 ymaxm = ymaxm+gapvd
522
523#ifdef WITH_ASSERT
524 ids(1) = itab_debug(irect(1,cand_m(i)))
525 ids(2) = itab_debug(irect(2,cand_m(i)))
526 ids(3) = itab_debug(irect(3,cand_m(i)))
527 ids(4) = itab_debug(irect(4,cand_m(i)))
528 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,ymaxs)
529 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,ymins)
530 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,ymaxm)
531 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,yminm)
532#endif
533
534 IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
535 nls=nls+1
536 list(nls)=is
537 ENDIF
538 ENDDO
539C ================ REMOTE TRIM 3
540 DO ls=nlf,nls
541 is=list(ls)
542 i=js+is
543 ii = cand_s(i)-nedge
544 nn1 = 2*(ii-1)+1
545 nn2 = 2*ii
546 x1s=xfie(nin)%P(1,nn1)
547 x2s=xfie(nin)%P(1,nn2)
548 gapvd = gapv(is)
549 xmins = min(x1s,x2s)-gapvd
550 xmaxs = max(x1s,x2s)+gapvd
551 xminm = boxm(1,cand_m(i))
552 xmaxm = boxm(2,cand_m(i))
553 xminm = xminm-gapvd
554 xmaxm = xmaxm+gapvd
555#ifdef WITH_ASSERT
556 ids(1) = itab_debug(irect(1,cand_m(i)))
557 ids(2) = itab_debug(irect(2,cand_m(i)))
558 ids(3) = itab_debug(irect(3,cand_m(i)))
559 ids(4) = itab_debug(irect(4,cand_m(i)))
560 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,xmaxs)
561 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,xmins)
562 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,xmaxm)
563 debug_e2e(int_checksum(ids,4,1)==d_em .AND. ledge_fie(nin)%P(e_global_id,cand_s(i)-nedge) == d_es,xminm)
564#endif
565
566 IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
567
568 cand_s(i) = -cand_s(i)
569 count_cand = count_cand+1
570 ct = ct+1
571 list_real_candidate(count_cand) = i
572
573 ENDIF
574 ENDDO
575 CALL sync_data(nls2)
576 END IF
577 js = js + nseg
578 ENDDO
579 IF (ifq > 0) THEN
580#include "vectorize.inc"
581 DO j=1,count_cand
582 i = list_real_candidate(j)
583 IF(ifpen(i) == 0 ) THEN
584 cand_fx(1:4,i) = zero
585 cand_fy(1:4,i) = zero
586 cand_fz(1:4,i) = zero
587 ENDIF
588 ENDDO
589 DO i=first,last
590 ifpen(i) = 0
591 ENDDO
592 ENDIF
593C
594#include "lockon.inc"
595 lskyi_count=lskyi_count+count_cand*5
596 count_remslve(nin)=count_remslve(nin)+ct
597#include "lockoff.inc"
598
599C
600C
601 IF(sol_edge/=0)THEN
602
603 CALL my_barrier
604
605 IF(itask==0)DEALLOCATE(tagm,boxm)
606
607 END IF
608
609 DEALLOCATE( list_real_candidate )
610C
611 RETURN
612 END
613
sync_data
subroutine sync_data(ii)
Definition machine.F:381
i25main_opt_tri
subroutine i25main_opt_tri(nin, ipari, intbuf_tab, x, v, itask, itab, kinet, count_remslv, count_remslve, nb_candt, i_opt_stok)
Definition i25main_opt_tri.F:42
i25optcd_e2s
subroutine i25optcd_e2s(cand_m, cand_s, x, i_stok, irect, nin, v, gap_m, igap, itask, stf, gap_m_l, count_remslve, drad, iedge, nedge, ledge, mvoisin, nsv, nrtm, gape, gap_e_l, igap0, stfe, s_stfe, ifq, ifpen, cand_fx, cand_fy, cand_fz, dgapload)
Definition i25optcd_e2s.F:43
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
debug_mod
Definition debug_mod.F:45
debug_mod::itab_debug
integer, dimension(:), allocatable itab_debug
User Node Identifiers.
Definition debug_mod.F:48
debug_mod::int_checksum
pure integer function int_checksum(a, siz1, siz2)
Definition debug_mod.F:167
tri25ebox::gape_l_fie
type(real_pointer), dimension(:), allocatable gape_l_fie
Definition tri25ebox.F:86
tri25ebox::ledge_fie
type(int_pointer2), dimension(:), allocatable ledge_fie
Definition tri25ebox.F:88
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
my_barrier
subroutine my_barrier
Definition machine.F:31