OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25optcd_edg.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_edg ../engine/source/interfaces/intsort/i25optcd_edg.F
25!||--- called by ------------------------------------------------------
26!|| i25main_opt_tri ../engine/source/interfaces/intsort/i25main_opt_tri.F
27!||--- calls -----------------------------------------------------
28!|| sync_data ../engine/source/system/machine.F
29!||--- uses -----------------------------------------------------
30!|| tri25ebox ../engine/share/modules/tri25ebox.F
31!|| tri7box ../engine/share/modules/tri7box.F
32!||====================================================================
33 SUBROUTINE i25optcd_edg(CAND_M,CAND_S,X ,I_STOK,IRECT ,
34 2 NIN ,V ,GAPE ,IGAP ,ITASK ,
35 3 STF ,GAP_E_L,COUNT_REMSLVE,DRAD ,
36 4 IEDGE ,NEDGE ,LEDGE ,MVOISIN,NSV,
37 5 IGAP0 ,STFE,
38 6 S_STFM, S_STFE,IFQ ,IFPEN ,
39 7 CAND_FX,CAND_FY,CAND_FZ,DGAPLOAD)
40
41C============================================================================
42C M o d u l e s
43C-----------------------------------------------
44 USE tri25ebox
45 USE tri7box
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50#include "comlock.inc"
51C-----------------------------------------------
52C G l o b a l P a r a m e t e r s
53C-----------------------------------------------
54#include "mvsiz_p.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER, INTENT(IN) :: S_STFM, S_STFE,IFQ
59 INTEGER IRECT(4,*),CAND_M(*), CAND_S(*),
60 . I_STOK, NIN,IGAP ,ITASK, COUNT_REMSLVE(*),
61 . IEDGE, NEDGE, IGAP0, LEDGE(NLEDGE,*), MVOISIN(4,*), NSV(*),
62 . IFPEN(*)
63 my_real , INTENT(IN) :: DGAPLOAD ,DRAD
64 my_real
65 . x(3,*),gape(*),v(3,*),stf(s_stfm),gap_e_l(*), stfe(s_stfe),
66 . cand_fx(*),cand_fy(*),cand_fz(*)
67C-----------------------------------------------
68C C o m m o n B l o c k s
69C-----------------------------------------------
70#include "task_c.inc"
71#include "com01_c.inc"
72#include "param_c.inc"
73#include "parit_c.inc"
74#include "i25edge_c.inc"
75#include "assert.inc"
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER I , L, E, IE, JE, NN1, NN2, IL, JL, I1, I2, SOL_EDGE, SH_EDGE, SHFT_EDGE
80 my_real
81 . XI,X1,X2,X3,X4,YI,Y1,Y2,Y3,Y4,ZI,Z1,Z2,Z3,Z4,
82 . XMINS,XMAXS,YMINS,YMAXS,ZMINS,ZMAXS,
83 . XMINM,XMAXM,YMINM,YMAXM,ZMINM,ZMAXM,
84 . V12,V22,V32,V42,VV,GAPVD
85 INTEGER MSEG,CT
86 my_real
87 . gapv(mvsiz),dtti(mvsiz),s
88 INTEGER LIST(MVSIZ), LISTI(MVSIZ)
89 INTEGER IS,JS,LS,NLS,NLT,NSEG,NLF,II,NLS2
90 INTEGER N1,N2,M1,M2
91 INTEGER SG, FIRST, LAST,COUNT_CAND
92C-----------------------------------------------
93C Debug
94 INTEGER EID
95C-----------------------------------------------
96
97 sol_edge=iedge/10 ! solids
98 sh_edge =iedge-10*sol_edge ! shells
99C-----------------------------------------------
100 count_cand = 0
101 ct = 0
102 mseg = nvsiz
103 first = 1 + i_stok*itask / nthread
104 last = i_stok*(itask+1) / nthread
105C-----
106 js = first-1
107 DO sg = first,last,mseg
108 nseg = min(mseg,last-js)
109 nls=0
110 IF(nspmd>1) THEN
111C
112C Partage cand_n local / frontiere
113C
114 nls = 0
115 nls2 = nseg+1
116 DO is = 1, nseg
117
118 i=js+is
119
120 IF(sh_edge==1.AND.ledge(3,cand_m(i))/=0) cycle ! Shell edge is not a free edge
121
122 IF(cand_s(i)<=nedge)THEN
123C CAND_S is local
124 IF(sh_edge==1.AND.ledge(3,cand_s(i))/=0) cycle ! Shell edge is not a free edge
125
126 IF(sh_edge==3 .AND.
127 . ledge(3,cand_m(i))/=0 .AND.
128 . ledge(3,cand_s(i))/=0) cycle ! One of the 2 edges is not a free edge
129
130 debug_e2e(ledge(8,cand_m(i)) == d_em .AND. ledge(8,cand_s(i)) == d_es,stfe(cand_s(i)))
131 debug_e2e(ledge(8,cand_m(i)) == d_em .AND. ledge(8,cand_s(i)) == d_es,cand_s(i))
132
133 nls=nls+1
134 listi(nls)=is
135 ELSE ! CAND_S is remote
136
137 IF(sh_edge==1.AND.ledge_fie(nin)%P(e_right_seg,cand_s(i)-nedge)/=0) cycle ! Shell edge is not a free edge
138C IF(SH_EDGE==1.AND.LEDGE(3,CAND_M(I))/=0) CYCLE ! Shell edge is not a free edge
139
140 IF(sh_edge==3 .AND.
141 . ledge(3,cand_m(i))/=0 .AND.
142 . ledge_fie(nin)%P(e_right_seg,cand_s(i)-nedge)/=0) cycle ! One of the 2 edges is not a free edge
143 debug_e2e(ledge(8,cand_m(i))==d_em.AND.ledge_fie(nin)%P(1,cand_s(i)-nedge)==d_es,stifie(nin)%P(cand_s(i)-nedge))
144
145 nls2=nls2-1
146 assert(is <= mvsiz)
147 assert(is > 0)
148 listi(nls2) = is
149 ENDIF
150 ENDDO
151
152 DO ls = 1, nls
153 is = listi(ls)
154 i=js+is
155
156 ie=cand_m(i)
157 je=cand_s(i)
158
159 IF(igap0 == 0) THEN
160 gapv(is)=two*gape(ie)+gape(je)
161 ELSE
162 gapv(is)=two*(gape(ie)+gape(je))
163 END IF
164
165 IF(igap==3)
166 . gapv(is)=min(gapv(is),gap_e_l(ie)+gap_e_l(je))
167
168 ENDDO
169
170 ELSE !NSPMD == 1
171 nls = 0
172 DO is=1,nseg
173
174 i=js+is
175
176
177 IF(sh_edge==1.AND.ledge(3,cand_m(i))/=0) cycle ! Shell edge is not a free edge
178
179 IF(sh_edge==1.AND.ledge(3,cand_s(i))/=0) cycle ! Shell edge is not a free edge
180
181 IF(sh_edge==3 .AND.
182 . ledge(3,cand_m(i))/=0 .AND.
183 . ledge(3,cand_s(i))/=0) cycle ! One of the 2 edges is not a free edge
184
185 eid = ledge(8,cand_s(i))
186 debug_e2e(ledge(8,cand_m(i)) == d_em .AND.ledge(8,cand_s(i))==d_es,stfe(cand_s(i)))
187 debug_e2e(ledge(8,cand_m(i)) == d_em .AND. ledge(8,cand_s(i)) == d_es,cand_s(i))
188
189 nls=nls+1
190 listi(nls)=is
191 ENDDO
192
193 DO ls = 1, nls
194 is = listi(ls)
195 i=js+is
196
197 ie=cand_m(i)
198 je=cand_s(i)
199
200 IF(igap0 == 0) THEN
201 gapv(is)=two*gape(ie)+gape(je)
202 ELSE
203 gapv(is)=two*(gape(ie)+gape(je))
204 END IF
205
206 IF(igap==3)
207 . gapv(is)=min(gapv(is),gap_e_l(ie)+gap_e_l(je))
208 ENDDO
209 ENDIF
210
211C Loop over local candidates
212 nlf = 1
213 nlt = nls
214 nls=0
215 DO ls = nlf, nlt
216 is = listi(ls)
217 i=js+is
218 l = ledge(1,cand_s(i))
219 s = zero
220 IF( l > 0 ) THEN
221 s = stfe(cand_s(i))
222 ELSE IF(l < 0) THEN
223 s = one
224 ENDIF
225 IF (s/=zero) THEN
226 n1= ledge(5,cand_s(i))
227 z1=x(3,n1)
228 n2= ledge(6,cand_s(i))
229 z2=x(3,n2)
230 l = ledge(1,cand_m(i))
231 s = zero
232 IF( l > 0 ) THEN
233 s = stf(l)
234 ELSEIF(l < 0) THEN
235 s = zero
236 ENDIF
237 IF (s/=zero) THEN
238 m1= ledge(5,cand_m(i))
239 z3=x(3,m1)
240 m2= ledge(6,cand_m(i))
241 z4=x(3,m2)
242 gapvd = max(gapv(is),drad)
243 zmins = min(z1,z2)-gapvd
244 zmaxs = max(z1,z2)+gapvd
245 zminm = min(z3,z4)-gapvd
246 zmaxm = max(z3,z4)+gapvd
247 IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
248 nls=nls+1
249 list(nls)=is
250 ENDIF
251 ENDIF
252 ENDIF
253 ENDDO
254C
255 nlt=nls
256 nls=0
257 DO ls=nlf,nlt
258 is=list(ls)
259 i=js+is
260 n1= ledge(5,cand_s(i))
261 y1=x(2,n1)
262 n2= ledge(6,cand_s(i))
263 y2=x(2,n2)
264 m1= ledge(5,cand_m(i))
265 y3=x(2,m1)
266 m2= ledge(6,cand_m(i))
267 y4=x(2,m2)
268 gapvd = max(gapv(is),drad)
269 ymins = min(y1,y2)-gapvd
270 ymaxs = max(y1,y2)+gapvd
271 yminm = min(y3,y4)-gapvd
272 ymaxm = max(y3,y4)+gapvd
273 IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
274 nls=nls+1
275 list(nls)=is
276 ENDIF
277 ENDDO
278C
279 DO ls=nlf,nls
280 is=list(ls)
281 i=js+is
282 n1= ledge(5,cand_s(i))
283 x1=x(1,n1)
284 n2= ledge(6,cand_s(i))
285 x2=x(1,n2)
286 m1= ledge(5,cand_m(i))
287 x3=x(1,m1)
288 m2= ledge(6,cand_m(i))
289 x4=x(1,m2)
290 gapvd = max(gapv(is)+dgapload,drad)
291 xmins = min(x1,x2)-gapvd
292 xmaxs = max(x1,x2)+gapvd
293 xminm = min(x3,x4)-gapvd
294 xmaxm = max(x3,x4)+gapvd
295 IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
296 cand_s(i) = -cand_s(i)
297 count_cand = count_cand+1
298 ENDIF
299 ENDDO
300C
301 IF(nspmd>1)THEN
302C loop over remote candidates
303 nlf = nls2
304 nlt = nseg
305 DO ls = nlf, nlt
306 is = listi(ls)
307 i=js+is
308 ie=cand_m(i)
309 IF(igap0 == 0) THEN
310 gapv(is)=two*gape(ie)+gapfie(nin)%P(cand_s(i)-nedge)
311 ELSE
312 gapv(is)=two*(gape(ie)+gapfie(nin)%P(cand_s(i)-nedge))
313 END IF
314
315 IF(igap==3)
316 . gapv(is)=min(gapv(is),gape_l_fie(nin)%P(cand_s(i)-nedge)+gap_e_l(ie))
317
318 ENDDO
319C
320 nls=0
321 DO ls = nlf, nlt
322C conserver LISTI et LIST pour optimiser le code genere (IA64)
323 is = listi(ls)
324 i=js+is
325 ii = cand_s(i)-nedge
326 assert(ii > 0)
327 assert(is > 0)
328 assert(is <= mvsiz)
329C IF (STIFIE(NIN)%P(II)/=ZERO) THEN
330
331 IF (stifie(nin)%P(ii)/=zero) THEN
332 nn1 = 2*(ii-1)+1
333 nn2 = 2*ii
334 z1=xfie(nin)%P(3,nn1)
335 z2=xfie(nin)%P(3,nn2)
336 l = ledge(1,cand_m(i))
337 s = zero
338 IF( l > 0) THEN
339 s = stf(l)
340 ELSE IF( l < 0) THEN
341 s = zero
342 ENDIF
343 IF (s/=zero) THEN
344 m1= ledge(5,cand_m(i))
345 z3=x(3,m1)
346 m2= ledge(6,cand_m(i))
347 z4=x(3,m2)
348 gapvd = max(gapv(is)+dgapload,drad)
349 zmins = min(z1,z2)-gapvd
350 zmaxs = max(z1,z2)+gapvd
351 zminm = min(z3,z4)-gapvd
352 zmaxm = max(z3,z4)+gapvd
353 IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
354 nls=nls+1
355 list(nls)=is
356 ENDIF
357 ENDIF
358 ENDIF
359 ENDDO
360C
361 nlf=1
362 nlt=nls
363 nls=0
364 DO ls=nlf,nlt
365 is=list(ls)
366 i=js+is
367 ii = cand_s(i)-nedge
368 nn1 = 2*(ii-1)+1
369 nn2 = 2*ii
370 y1=xfie(nin)%P(2,nn1)
371 y2=xfie(nin)%P(2,nn2)
372 m1= ledge(5,cand_m(i))
373 y3=x(2,m1)
374 m2= ledge(6,cand_m(i))
375 y4=x(2,m2)
376 gapvd = max(gapv(is)+dgapload,drad)
377 ymins = min(y1,y2)-gapvd
378 ymaxs = max(y1,y2)+gapvd
379 yminm = min(y3,y4)-gapvd
380 ymaxm = max(y3,y4)+gapvd
381 IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
382 nls=nls+1
383 list(nls)=is
384 ENDIF
385 ENDDO
386C
387 DO ls=nlf,nls
388 is=list(ls)
389 i=js+is
390 ii = cand_s(i)-nedge
391 nn1 = 2*(ii-1)+1
392 nn2 = 2*ii
393 x1=xfie(nin)%P(1,nn1)
394 x2=xfie(nin)%P(1,nn2)
395 m1= ledge(5,cand_m(i))
396 x3=x(1,m1)
397 m2= ledge(6,cand_m(i))
398 x4=x(1,m2)
399 gapvd = max(gapv(is)+dgapload,drad)
400 xmins = min(x1,x2)-gapvd
401 xmaxs = max(x1,x2)+gapvd
402 xminm = min(x3,x4)-gapvd
403 xmaxm = max(x3,x4)+gapvd
404 IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
405 cand_s(i) = -cand_s(i)
406 count_cand = count_cand+1
407 ct = ct+1
408 ENDIF
409 ENDDO
410 CALL sync_data(nls2)
411 END IF
412 js = js + nseg
413 ENDDO
414 IF (ifq > 0) THEN
415 DO i=first,last
416 IF (ifpen(i) == 0 ) THEN
417 cand_fx(i) = zero
418 cand_fy(i) = zero
419 cand_fz(i) = zero
420 ENDIF
421 ifpen(i) = 0
422 ENDDO
423 ENDIF
424C
425#include "lockon.inc"
426 lskyi_count=lskyi_count+count_cand*5
427 count_remslve(nin)=count_remslve(nin)+ct
428#include "lockoff.inc"
429
430C
431 RETURN
432 END
433
sync_data
subroutine sync_data(ii)
Definition machine.F:381
i25optcd_edg
subroutine i25optcd_edg(cand_m, cand_s, x, i_stok, irect, nin, v, gape, igap, itask, stf, gap_e_l, count_remslve, drad, iedge, nedge, ledge, mvoisin, nsv, igap0, stfe, s_stfm, s_stfe, ifq, ifpen, cand_fx, cand_fy, cand_fz, dgapload)
Definition i25optcd_edg.F:40
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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