OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24optcd.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!|| i24optcd ../engine/source/interfaces/intsort/i24optcd.F
25!||--- called by ------------------------------------------------------
26!|| i24main_opt_tri ../engine/source/interfaces/intsort/i24main_opt_tri.F
27!||--- calls -----------------------------------------------------
28!|| i24ispt2_ini_opttri ../engine/source/interfaces/int24/i24cor3.F
29!|| sync_data ../engine/source/system/machine.F
30!||--- uses -----------------------------------------------------
31!|| debug_mod ../engine/share/modules/debug_mod.F
32!|| tri7box ../engine/share/modules/tri7box.F
33!||====================================================================
34 SUBROUTINE i24optcd(
35 1 NSV ,CAND_E ,CAND_N ,X ,I_STOK ,
36 2 IRECT ,GAP_S ,GAP_M ,V ,ICURV ,
37 3 STFN ,ITASK ,STF ,NIN ,NSN ,
38 4 IRTLM ,TIME_S ,MSEGLO ,COUNT_REMSLV,
39 5 SECND_FR,NSNR ,PENE_OLD,STIF_OLD ,
40 6 PMAX_GAP,EDGE_L2,IEDGE ,IGSTI ,MVOISIN ,
41 7 ICONT_I ,IS2SE,IRTSE,
42 8 NSNE,NRTSE,IS2PT,ISPT2,ISEGPT,IEDG4,T2MAIN_SMS,
43 9 LSKYI_SMS_NEW,DGAPLOAD)
44C========================================================================
45C M o d u l e s
46C-----------------------------------------------
47 USE tri7box
48 USE debug_mod
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53#include "comlock.inc"
54C-----------------------------------------------
55C G l o b a l P a r a m e t e r s
56C-----------------------------------------------
57#include "mvsiz_p.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "scr05_c.inc"
62#include "com01_c.inc"
63#include "com08_c.inc"
64#include "param_c.inc"
65#include "task_c.inc"
66#include "parit_c.inc"
67#include "com04_c.inc"
68#include "sms_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER NSNR,IEDGE,I_STOK,NIN ,ITASK, NSN, ICURV,
73 . IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
74 . IRTLM(2,NSN),MSEGLO(*),COUNT_REMSLV(*),IGSTI ,MVOISIN(4,*),
75 . ICONT_I(*),IS2SE(2,*),IRTSE(5,*),NSNE,NRTSE,IS2PT(*),ISPT2(*),
76 . ISEGPT(*),IEDG4,T2MAIN_SMS(6,*),LSKYI_SMS_NEW
77 my_real
78 . GAP,PMAX_GAP,
79 . X(3,*),GAP_S(*),GAP_M(*),STFN(*),STF(*),
80 . V(3,*),SECND_FR(6,*),TIME_S(*),EDGE_L2(*),
81 . pene_old(5,nsn),stif_old(2,nsn)
82 my_real , INTENT(IN) :: dgapload
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER I,L,IS,JS,LS,NLS,NLT,NSEG,NLS2,SG,FIRST,LAST,MSEG,NLF,
87 . MG,II,NSNF,NSNL,N,IGL,N1,N2,N3,N4
88 INTEGER LIST(MVSIZ),IG(MVSIZ),IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),
89 . IX4(MVSIZ), LISTI(MVSIZ),COUNT_CAND,CT,NSNRF,NSNRL,SE,E,SN,ISEDGE,
90 . COUNT_CONNEC_SMS,NS,IE,KK
91 my_real
92 . xi,x1,x2,x3,x4,yi,y1,y2,y3,y4,zi,z1,z2,z3,z4,
93 . xmin,xmax,ymin,ymax,zmin,zmax,v12,v22,v32,v42
94 my_real
95 . gapv(mvsiz),edge_l(mvsiz),prec
96 my_real
97 . x0,y0,z0,xxx,yyy,zzz,curv_max,tzinf,vx,vy,vz,vv,
98 . vxi,vyi,vzi,
99 . vx1,vx2,vx3,vx4,vy1,vy2,vy3,vy4,vz1,vz2,vz3,vz4
100
101C-----------------------------------------------
102 ig(1:mvsiz) = 0
103 IF (iresp==1) THEN
104 prec = (seven+half)*em06
105 ELSE
106 prec = em8
107 ENDIF
108c write(iout,*)'i24optcd 1'
109 nsnf = 1 + itask*nsn / nthread
110 nsnl = (itask+1)*nsn / nthread
111 DO i = nsnf,nsnl
112c copy old friction forces
113 secnd_fr(4,i)=secnd_fr(1,i)
114 secnd_fr(5,i)=secnd_fr(2,i)
115 secnd_fr(6,i)=secnd_fr(3,i)
116c set new friction forces at 0
117 secnd_fr(1,i)=zero
118 secnd_fr(2,i)=zero
119 secnd_fr(3,i)=zero
120
121 time_s(i)=zero
122
123 pene_old(2,i) = pene_old(1,i)
124 stif_old(2,i) = stif_old(1,i)
125 pene_old(1,i) = zero
126 pene_old(3,i) = zero
127C STIF_OLD(1,I) = ZERO
128C CONT_I contains Starter infos, it must be flushed when IRTLM(1,xxx) is no more Zero.
129 IF(irtlm(1,i)/=0) icont_i(i)=0
130 ENDDO
131C----------------
132 IF (igsti/=6) THEN
133 DO i = nsnf,nsnl
134 stif_old(1,i) = zero
135 ENDDO
136 END IF
137
138 nsnrf = 1 + itask*nsnr / nthread
139 nsnrl = (itask+1)*nsnr / nthread
140
141 DO i=nsnrf,nsnrl
142 time_sfi(nin)%P(i)=zero
143 pene_oldfi(nin)%P(3,i)=zero
144C CONT_I contains Starter infos, it must be flushed when IRTLM(1,xxx) is no more Zero.
145 IF(irtlm_fi(nin)%P(1,i)/=0) icont_i_fi(nin)%P(i)=0
146 ENDDO
147C initialize PMAX_GAP to Zero for future treatments in force computation.
148 pmax_gap = zero
149
150 count_cand = 0
151 count_connec_sms = 0
152 ct = 0
153 mseg = nvsiz
154 first = 1 + i_stok*itask / nthread
155 last = i_stok*(itask+1) / nthread
156 js = first-1
157
158
159 DO sg = first,last,mseg
160 nseg = min(mseg,last-js)
161 nls=0
162
163 IF(nspmd>1) THEN
164C
165C Partage cand_n local / frontiere
166C
167 nls = 0
168 nls2 = nseg+1
169 DO is = 1, nseg
170 i=js+is
171 IF(cand_n(i)<=nsn)THEN
172 nls=nls+1
173 listi(nls)=is
174 ELSE
175 nls2=nls2-1
176 listi(nls2) = is
177 ENDIF
178 ENDDO
179 IF(iedge==0)THEN
180 DO ls = 1, nls
181 is = listi(ls)
182 i=js+is
183 gapv(is)=gap_s(cand_n(i)) + gap_m(cand_e(i))
184 edge_l(is)=zero
185 ENDDO
186 ELSE
187 DO ls = 1, nls
188 is = listi(ls)
189 i=js+is
190 gapv(is)=gap_s(cand_n(i)) + gap_m(cand_e(i))
191 edge_l(is)=edge_l2(cand_n(i))
192 ENDDO
193 ENDIF
194 ELSE
195 nls = nseg
196 IF(iedge==0)THEN
197 DO is=1,nseg
198 i=js+is
199 gapv(is)=gap_s(cand_n(i)) + gap_m(cand_e(i))
200 edge_l(is)=zero
201 listi(is)=is
202 ENDDO
203 ELSE
204 DO is=1,nseg
205 i=js+is
206 gapv(is)=gap_s(cand_n(i)) + gap_m(cand_e(i))
207 edge_l(is)=edge_l2(cand_n(i))
208 listi(is)=is
209 ENDDO
210 ENDIF
211 ENDIF
212C
213 nlf = 1
214 nlt = nls
215 nls=0
216 IF(icurv/=0)THEN
217 DO ls = nlf, nlt
218 is = listi(ls)
219 i=js+is
220 l = cand_e(i)
221 IF(stf(l)/=zero.AND.stfn(cand_n(i))/=zero) THEN
222 ig(is) = nsv(cand_n(i))
223 xi = x(1,ig(is))
224 yi = x(2,ig(is))
225 zi = x(3,ig(is))
226 ix1(is)=irect(1,l)
227 ix2(is)=irect(2,l)
228 ix3(is)=irect(3,l)
229 ix4(is)=irect(4,l)
230 x1=x(1,ix1(is))
231 x2=x(1,ix2(is))
232 x3=x(1,ix3(is))
233 x4=x(1,ix4(is))
234 y1=x(2,ix1(is))
235 y2=x(2,ix2(is))
236 y3=x(2,ix3(is))
237 y4=x(2,ix4(is))
238 z1=x(3,ix1(is))
239 z2=x(3,ix2(is))
240 z3=x(3,ix3(is))
241 z4=x(3,ix4(is))
242 x0 = fourth*(x1+x2+x3+x4)
243 y0 = fourth*(y1+y2+y3+y4)
244 z0 = fourth*(z1+z2+z3+z4)
245 xxx=max(x1,x2,x3,x4)-min(x1,x2,x3,x4)
246 yyy=max(y1,y2,y3,y4)-min(y1,y2,y3,y4)
247 zzz=max(z1,z2,z3,z4)-min(z1,z2,z3,z4)
248 curv_max = half * max(xxx,yyy,zzz)
249 vxi = v(1,ig(is))
250 vyi = v(2,ig(is))
251 vzi = v(3,ig(is))
252 vx1=v(1,ix1(is))
253 vx2=v(1,ix2(is))
254 vx3=v(1,ix3(is))
255 vx4=v(1,ix4(is))
256 vy1=v(2,ix1(is))
257 vy2=v(2,ix2(is))
258 vy3=v(2,ix3(is))
259 vy4=v(2,ix4(is))
260 vz1=v(3,ix1(is))
261 vz2=v(3,ix2(is))
262 vz3=v(3,ix3(is))
263 vz4=v(3,ix4(is))
264 vx=max(max(vx1,vx2,vx3,vx4)-vxi,vxi-min(vx1,vx2,vx3,vx4))
265 vy=max(max(vy1,vy2,vy3,vy4)-vyi,vyi-min(vy1,vy2,vy3,vy4))
266 vz=max(max(vz1,vz2,vz3,vz4)-vzi,vzi-min(vz1,vz2,vz3,vz4))
267 vv = onep01*max(vx,vy,vz)
268c PMAX_GAP is not used here (node not in contact)
269 tzinf = max(curv_max+gapv(is)+dgapload,vv*dt1,edge_l(is))
270 tzinf = max(prec,tzinf)
271 xmin = x0-tzinf
272 ymin = y0-tzinf
273 zmin = z0-tzinf
274 xmax = x0+tzinf
275 ymax = y0+tzinf
276 zmax = z0+tzinf
277 IF (xmin <= xi.AND.xmax >= xi.AND.
278 . ymin <= yi.AND.ymax >= yi.AND.
279 . zmin <= zi.AND.zmax >= zi) THEN
280 cand_n(i) = -cand_n(i)
281C
282 IF ((idtmins /= 2).AND.(idtmins_int == 0)) THEN
283 count_cand = count_cand+1
284 IF(ig(is) > numnod) count_cand = count_cand + 3
285 ELSE
286CC-- Count of contact connections for AMS (+ additional connections related to contact on type2 - T2MAIN_SMS(1) > 1)
287 IF(ig(is) > numnod) THEN
288 count_cand = count_cand+4
289 ns = ig(is) - numnod
290 IF (is2se(1,ns) > 0) THEN
291 ie = is2se(1,ns)
292 ELSE
293 ie = is2se(2,ns)
294 ENDIF
295 DO kk=1,4
296 count_connec_sms = count_connec_sms + t2main_sms(1,irtse(kk,ie))*
297 . (t2main_sms(1,ix1(is))+t2main_sms(1,ix2(is))+t2main_sms(1,ix3(is))+t2main_sms(1,ix4(is)))
298 ENDDO
299 ELSE
300 count_cand = count_cand+1
301 count_connec_sms = count_connec_sms + t2main_sms(1,ig(is))*
302 . (t2main_sms(1,ix1(is))+t2main_sms(1,ix2(is))+t2main_sms(1,ix3(is))+t2main_sms(1,ix4(is)))
303 ENDIF
304C
305 ENDIF
306 ENDIF
307 ENDIF
308 ENDDO
309 ELSE
310 DO ls = nlf, nlt
311C conserver LISTI et LIST pour optimiser le code genere (IA64)
312 is = listi(ls)
313 i=js+is
314 l = cand_e(i)
315 irtlm(1,cand_n(i)) = iabs(irtlm(1,cand_n(i)))
316 mg = irtlm(1,cand_n(i))
317 IF(stf(l)/=zero.AND.stfn(cand_n(i))/=zero) THEN
318 IF(mg /= 0 .and. mg /= mseglo(cand_e(i))) THEN
319c secnd in contact on an other main don't keep candidate
320 time_s(cand_n(i))=zero
321 ELSEIF(mg == mseglo(cand_e(i)))THEN
322c secnd in contact on this main keep candidate
323 nls=nls+1
324 list(nls)=is
325 ELSE
326c secnd not in contact
327 ig(is) = nsv(cand_n(i))
328 zi = x(3,ig(is))
329 ix1(is)=irect(1,l)
330 z1=x(3,ix1(is))
331 ix2(is)=irect(2,l)
332 z2=x(3,ix2(is))
333 ix3(is)=irect(3,l)
334 z3=x(3,ix3(is))
335 ix4(is)=irect(4,l)
336 z4=x(3,ix4(is))
337 vzi = v(3,ig(is))
338 vz1=v(3,ix1(is))
339 vz2=v(3,ix2(is))
340 vz3=v(3,ix3(is))
341 vz4=v(3,ix4(is))
342 vz=max(max(vz1,vz2,vz3,vz4)-vzi,vzi-min(vz1,vz2,vz3,vz4))
343c PMAX_GAP is not used here (node not in contact)
344 tzinf = max(gapv(is)+dgapload,onep01*vz*dt1,edge_l(is))
345 tzinf = max(prec,tzinf)
346 zmin = min(z1,z2,z3,z4)-tzinf
347 zmax = max(z1,z2,z3,z4)+tzinf
348 IF (zmin<=zi.AND.zmax>=zi) THEN
349 nls=nls+1
350 list(nls)=is
351 ELSE
352 time_s(cand_n(i))=zero
353 ENDIF
354 ENDIF
355 ELSE
356C Shooting Nodes
357C Reset IRTLM when a Secnd node is in contact with a Main surface
358C which was deleted.
359 IF(stf(l)==zero)THEN
360 mg = irtlm(1,cand_n(i))
361 IF (mg == mseglo(cand_e(i)))THEN
362 irtlm(1,cand_n(i))=0
363 time_s(cand_n(i))=-ep20
364 ENDIF
365 ENDIF
366 IF(stfn(cand_n(i))==zero)THEN
367 irtlm(1,cand_n(i))=0
368 time_s(cand_n(i))=-ep20
369 ENDIF
370 ENDIF
371 ENDDO
372C
373 nlt=nls
374 nls=0
375 DO ls=nlf,nlt
376 is=list(ls)
377 i=js+is
378 mg = irtlm(1,cand_n(i))
379 IF(mg == mseglo(cand_e(i)))THEN
380c secnd in contact on this main keep candidate
381 nls=nls+1
382 list(nls)=is
383 ELSE
384c secnd not in contact
385 yi=x(2,ig(is))
386 y1=x(2,ix1(is))
387 y2=x(2,ix2(is))
388 y3=x(2,ix3(is))
389 y4=x(2,ix4(is))
390 vyi = v(2,ig(is))
391 vy1=v(2,ix1(is))
392 vy2=v(2,ix2(is))
393 vy3=v(2,ix3(is))
394 vy4=v(2,ix4(is))
395 vy=max(max(vy1,vy2,vy3,vy4)-vyi,vyi-min(vy1,vy2,vy3,vy4))
396c PMAX_GAP is not used here (node not in contact)
397 tzinf = max(gapv(is)+dgapload,onep01*vy*dt1,edge_l(is))
398 tzinf = max(prec,tzinf)
399 ymin = min(y1,y2,y3,y4)-tzinf
400 ymax = max(y1,y2,y3,y4)+tzinf
401 IF (ymin<=yi.AND.ymax>=yi) THEN
402 nls=nls+1
403 list(nls)=is
404 ELSE
405 time_s(cand_n(i))=zero
406 ENDIF
407 ENDIF
408 ENDDO
409C
410 DO ls=nlf,nls
411 is=list(ls)
412 i=js+is
413 mg = irtlm(1,cand_n(i))
414 IF(mg == mseglo(cand_e(i)))THEN
415c secnd in contact on this main keep candidate
416 IF ((idtmins /= 2).AND.(idtmins_int == 0)) THEN
417 cand_n(i) = -cand_n(i)
418 count_cand = count_cand+1
419 IF(ig(is) > numnod) count_cand = count_cand + 3
420 ELSE
421CC-- Count of contact connections for AMS (+ additional connections related to contact on type2 - T2MAIN_SMS(1) > 1)
422 ig(is) = nsv(cand_n(i))
423 cand_n(i) = -cand_n(i)
424 l = cand_e(i)
425 ix1(is)=irect(1,l)
426 ix2(is)=irect(2,l)
427 ix3(is)=irect(3,l)
428 ix4(is)=irect(4,l)
429C
430 IF(ig(is) > numnod) THEN
431 count_cand = count_cand+4
432 ns = ig(is) - numnod
433 IF (is2se(1,ns) > 0) THEN
434 ie = is2se(1,ns)
435 ELSE
436 ie = is2se(2,ns)
437 ENDIF
438 DO kk=1,4
439 count_connec_sms = count_connec_sms + t2main_sms(1,irtse(kk,ie))*
440 . (t2main_sms(1,ix1(is))+t2main_sms(1,ix2(is))+t2main_sms(1,ix3(is))+t2main_sms(1,ix4(is)))
441 ENDDO
442 ELSE
443 count_cand = count_cand+1
444 count_connec_sms = count_connec_sms + t2main_sms(1,ig(is))*
445 . (t2main_sms(1,ix1(is))+t2main_sms(1,ix2(is))+t2main_sms(1,ix3(is))+t2main_sms(1,ix4(is)))
446 ENDIF
447 ENDIF
448 ELSE
449c secnd not in contact
450 xi=x(1,ig(is))
451 x1=x(1,ix1(is))
452 x2=x(1,ix2(is))
453 x3=x(1,ix3(is))
454 x4=x(1,ix4(is))
455 vxi = v(1,ig(is))
456 vx1=v(1,ix1(is))
457 vx2=v(1,ix2(is))
458 vx3=v(1,ix3(is))
459 vx4=v(1,ix4(is))
460 vx=max(max(vx1,vx2,vx3,vx4)-vxi,vxi-min(vx1,vx2,vx3,vx4))
461c PMAX_GAP is not used here (node not in contact)
462 tzinf = max(gapv(is)+dgapload,onep01*vx*dt1,edge_l(is))
463 tzinf = max(prec,tzinf)
464 xmin = min(x1,x2,x3,x4)-tzinf
465 xmax = max(x1,x2,x3,x4)+tzinf
466 IF (xmin<=xi.AND.xmax>=xi) THEN
467 cand_n(i) = -cand_n(i)
468 IF ((idtmins /= 2).AND.(idtmins_int == 0)) THEN
469 count_cand = count_cand+1
470 IF(ig(is) > numnod) count_cand = count_cand + 3
471 ELSE
472CC-- Count of contact connections for AMS (+ additional connections related to contact on type2 - T2MAIN_SMS(1) > 1)
473 IF(ig(is) > numnod) THEN
474 count_cand = count_cand+4
475 ns = ig(is) - numnod
476 IF (is2se(1,ns) > 0) THEN
477 ie = is2se(1,ns)
478 ELSE
479 ie = is2se(2,ns)
480 ENDIF
481 DO kk=1,4
482 count_connec_sms = count_connec_sms + t2main_sms(1,irtse(kk,ie))*
483 . (t2main_sms(1,ix1(is))+t2main_sms(1,ix2(is))+t2main_sms(1,ix3(is))+t2main_sms(1,ix4(is)))
484 ENDDO
485 ELSE
486 count_cand = count_cand+1
487 count_connec_sms = count_connec_sms + t2main_sms(1,ig(is))*
488 . (t2main_sms(1,ix1(is))+t2main_sms(1,ix2(is))+t2main_sms(1,ix3(is))+t2main_sms(1,ix4(is)))
489 ENDIF
490 ENDIF
491 ELSE
492 time_s(cand_n(i))=zero
493 ENDIF
494 ENDIF
495 ENDDO
496 ENDIF
497c write(iout,*)'i24optcd 2'
498 IF(nspmd>1)THEN
499 nlf = nls2
500 nlt = nseg
501 IF(iedge==0)THEN
502 DO ls = nlf, nlt
503 is = listi(ls)
504 i=js+is
505 gapv(is)=gapfi(nin)%P(cand_n(i)-nsn) + gap_m(cand_e(i))
506 edge_l(is)=zero
507 ENDDO
508 ELSE
509 DO ls = nlf, nlt
510 is = listi(ls)
511 i=js+is
512 gapv(is)=gapfi(nin)%P(cand_n(i)-nsn) + gap_m(cand_e(i))
513 edge_l(is)=zero
514c a faire EDGE_L(IS)=EDGE_L2FI(NIN)%P(CAND_N(I)-NSN)
515 ENDDO
516 ENDIF
517 IF(icurv/=0)THEN
518 DO ls = nlf, nlt
519 is = listi(ls)
520 i=js+is
521 ii = cand_n(i)-nsn
522 l = cand_e(i)
523 IF(stf(l)/=zero.AND.stifi(nin)%P(ii)/=zero) THEN
524 xi = xfi(nin)%P(1,ii)
525 yi = xfi(nin)%P(2,ii)
526 zi = xfi(nin)%P(3,ii)
527 ix1(is)=irect(1,l)
528 ix2(is)=irect(2,l)
529 ix3(is)=irect(3,l)
530 ix4(is)=irect(4,l)
531 x1=x(1,ix1(is))
532 x2=x(1,ix2(is))
533 x3=x(1,ix3(is))
534 x4=x(1,ix4(is))
535 y1=x(2,ix1(is))
536 y2=x(2,ix2(is))
537 y3=x(2,ix3(is))
538 y4=x(2,ix4(is))
539 z1=x(3,ix1(is))
540 z2=x(3,ix2(is))
541 z3=x(3,ix3(is))
542 z4=x(3,ix4(is))
543 x0 = fourth*(x1+x2+x3+x4)
544 y0 = fourth*(y1+y2+y3+y4)
545 z0 = fourth*(z1+z2+z3+z4)
546 xxx=max(x1,x2,x3,x4)-min(x1,x2,x3,x4)
547 yyy=max(y1,y2,y3,y4)-min(y1,y2,y3,y4)
548 zzz=max(z1,z2,z3,z4)-min(z1,z2,z3,z4)
549 curv_max = half * max(xxx,yyy,zzz)
550 vxi = vfi(nin)%P(1,ii)
551 vyi = vfi(nin)%P(2,ii)
552 vzi = vfi(nin)%P(3,ii)
553 vx1=v(1,ix1(is))
554 vx2=v(1,ix2(is))
555 vx3=v(1,ix3(is))
556 vx4=v(1,ix4(is))
557 vy1=v(2,ix1(is))
558 vy2=v(2,ix2(is))
559 vy3=v(2,ix3(is))
560 vy4=v(2,ix4(is))
561 vz1=v(3,ix1(is))
562 vz2=v(3,ix2(is))
563 vz3=v(3,ix3(is))
564 vz4=v(3,ix4(is))
565 vx=max(max(vx1,vx2,vx3,vx4)-vxi,vxi-min(vx1,vx2,vx3,vx4))
566 vy=max(max(vy1,vy2,vy3,vy4)-vyi,vyi-min(vy1,vy2,vy3,vy4))
567 vz=max(max(vz1,vz2,vz3,vz4)-vzi,vzi-min(vz1,vz2,vz3,vz4))
568 vv = max(vx,vy,vz)
569c PMAX_GAP is not used here (node not in contact)
570 tzinf = max(curv_max+gapv(is)+dgapload,onep01*vv*dt1,edge_l(is))
571 tzinf = max(prec,tzinf)
572 xmin = x0-tzinf
573 ymin = y0-tzinf
574 zmin = z0-tzinf
575 xmax = x0+tzinf
576 ymax = y0+tzinf
577 zmax = z0+tzinf
578 IF (xmin <= xi.AND.xmax >= xi.AND.
579 . ymin <= yi.AND.ymax >= yi.AND.
580 . zmin <= zi.AND.zmax >= zi) THEN
581 cand_n(i) = -cand_n(i)
582 count_cand = count_cand+1
583 IF ((idtmins /= 2).AND.(idtmins_int == 0)) THEN
584 ct = ct + 1
585 IF(isedge_fi(nin)%P(ii)==1) ct = ct+3
586 ELSE
587CC-- Count of contact connections for AMS (+ additional connections related to contact on type2 - T2MAIN_SMS(1) > 1)
588 IF(isedge_fi(nin)%P(ii)==1) THEN
589 ct = ct + 4
590 IF (is2se_fi(nin)%P(1,ii) > 0) THEN
591 ie = is2se_fi(nin)%P(1,ii)
592 ELSE
593 ie = is2se_fi(nin)%P(2,ii)
594 ENDIF
595 DO kk=1,4
596 count_connec_sms = count_connec_sms + t2main_sms_fi(nin)%P(1,irtse_fi(nin)%P(kk,ie))*
597 . (t2main_sms(1,ix1(is))+t2main_sms(1,ix2(is))+t2main_sms(1,ix3(is))+t2main_sms(1,ix4(is)))
598 ENDDO
599 ELSE
600 ct = ct + 1
601 count_connec_sms = count_connec_sms + t2main_sms_fi(nin)%P(1,ii)*
602 . (t2main_sms(1,ix1(is))+t2main_sms(1,ix2(is))+t2main_sms(1,ix3(is))+t2main_sms(1,ix4(is)))
603 ENDIF
604 ENDIF
605 ELSE
606 time_sfi(nin)%P(ii)=zero
607 END IF
608 END IF
609 END DO
610 ELSE
611 nls=0
612 DO ls = nlf, nlt
613 is = listi(ls)
614 i=js+is
615 ii = cand_n(i)-nsn
616 l = cand_e(i)
617 irtlm_fi(nin)%P(1,ii)=iabs(irtlm_fi(nin)%P(1,ii))
618 mg = irtlm_fi(nin)%P(1,ii)
619 IF(stf(l)/=zero.AND.stifi(nin)%P(ii)/=zero) THEN
620 IF(mg /= 0 .and. mg /= mseglo(cand_e(i))) THEN
621c secnd in contact on a remote main don't keep candidate
622 time_sfi(nin)%P(ii)=zero
623 ELSEIF(mg == mseglo(cand_e(i)))THEN
624c secnd in contact on this main keep candidate
625 nls=nls+1
626 list(nls)=is
627 ELSE
628c secnd not in contact
629 zi = xfi(nin)%P(3,ii)
630 ix1(is)=irect(1,l)
631 z1=x(3,ix1(is))
632 ix2(is)=irect(2,l)
633 z2=x(3,ix2(is))
634 ix3(is)=irect(3,l)
635 z3=x(3,ix3(is))
636 ix4(is)=irect(4,l)
637 z4=x(3,ix4(is))
638 vzi = vfi(nin)%P(3,ii)
639 vz1=v(3,ix1(is))
640 vz2=v(3,ix2(is))
641 vz3=v(3,ix3(is))
642 vz4=v(3,ix4(is))
643 vz=max(max(vz1,vz2,vz3,vz4)-vzi,vzi-min(vz1,vz2,vz3,vz4))
644c PMAX_GAP is not used here (node not in contact)
645 tzinf = max(gapv(is)+dgapload,onep01*vz*dt1,edge_l(is))
646 tzinf = max(prec,tzinf)
647 zmin = min(z1,z2,z3,z4)-tzinf
648 zmax = max(z1,z2,z3,z4)+tzinf
649 IF (zmin<=zi.AND.zmax>=zi) THEN
650 nls=nls+1
651 list(nls)=is
652 ELSE
653 time_sfi(nin)%P(ii)=zero
654 ENDIF
655 ENDIF
656 ELSE
657 IF(stf(l)==zero)THEN
658 mg = irtlm_fi(nin)%P(1,ii)
659 IF (mg == mseglo(cand_e(i)))THEN
660 irtlm_fi(nin)%P(1,ii)=0
661 time_sfi(nin)%P(ii)=-ep20
662 ENDIF
663 ENDIF
664 IF(stifi(nin)%P(ii)==zero)THEN
665 irtlm_fi(nin)%P(1,ii)=0
666 time_sfi(nin)%P(ii)=-ep20
667 ENDIF
668 ENDIF
669 ENDDO
670C
671c write(iout,*)'i24optcd 3'
672 nlf=1
673 nlt=nls
674 nls=0
675 DO ls=nlf,nlt
676 is=list(ls)
677 i=js+is
678 ii = cand_n(i)-nsn
679 mg = irtlm_fi(nin)%P(1,ii)
680 IF(mg == mseglo(cand_e(i)))THEN
681c secnd in contact on this main keep candidate
682 nls=nls+1
683 list(nls)=is
684 ELSE
685c secnd not in contact
686 yi=xfi(nin)%P(2,ii)
687 y1=x(2,ix1(is))
688 y2=x(2,ix2(is))
689 y3=x(2,ix3(is))
690 y4=x(2,ix4(is))
691 vyi = vfi(nin)%P(2,ii)
692 vy1=v(2,ix1(is))
693 vy2=v(2,ix2(is))
694 vy3=v(2,ix3(is))
695 vy4=v(2,ix4(is))
696 vy=max(max(vy1,vy2,vy3,vy4)-vyi,vyi-min(vy1,vy2,vy3,vy4))
697c PMAX_GAP is not used here (node not in contact)
698 tzinf = max(gapv(is)+dgapload,onep01*vy*dt1,edge_l(is))
699 tzinf = max(prec,tzinf)
700 ymin = min(y1,y2,y3,y4)-tzinf
701 ymax = max(y1,y2,y3,y4)+tzinf
702 IF (ymin<=yi.AND.ymax>=yi) THEN
703 nls=nls+1
704 list(nls)=is
705 ELSE
706 time_sfi(nin)%P(ii)=zero
707 ENDIF
708 ENDIF
709 ENDDO
710C
711c write(iout,*)'i24optcd 4'
712 DO ls=nlf,nls
713 is=list(ls)
714 i=js+is
715 ii = cand_n(i)-nsn
716 mg = irtlm_fi(nin)%P(1,ii)
717 IF(mg == mseglo(cand_e(i)))THEN
718c secnd in contact on this main keep candidate
719 cand_n(i) = -cand_n(i)
720 count_cand = count_cand+1
721 IF ((idtmins /= 2).AND.(idtmins_int == 0)) THEN
722 ct = ct + 1
723 IF(isedge_fi(nin)%P(ii)==1) ct = ct+3
724 ELSE
725CC-- Count of contact connections for AMS (+ additional connections related to contact on type2 - T2MAIN_SMS(1) > 1)
726 l = cand_e(i)
727 ix1(is)=irect(1,l)
728 ix2(is)=irect(2,l)
729 ix3(is)=irect(3,l)
730 ix4(is)=irect(4,l)
731 IF(isedge_fi(nin)%P(ii)==1) THEN
732 ct = ct + 4
733 IF (is2se_fi(nin)%P(1,ii) > 0) THEN
734 ie = is2se_fi(nin)%P(1,ii)
735 ELSE
736 ie = is2se_fi(nin)%P(2,ii)
737 ENDIF
738 DO kk=1,4
739 count_connec_sms = count_connec_sms + t2main_sms_fi(nin)%P(1,irtse_fi(nin)%P(kk,ie))*
740 . (t2main_sms(1,ix1(is))+t2main_sms(1,ix2(is))+t2main_sms(1,ix3(is))+t2main_sms(1,ix4(is)))
741 ENDDO
742 ELSE
743 ct = ct + 1
744 count_connec_sms = count_connec_sms + t2main_sms_fi(nin)%P(1,ii)*
745 . (t2main_sms(1,ix1(is))+t2main_sms(1,ix2(is))+t2main_sms(1,ix3(is))+t2main_sms(1,ix4(is)))
746 ENDIF
747 ENDIF
748 ELSE
749c secnd not in contact
750 xi = xfi(nin)%P(1,ii)
751 x1=x(1,ix1(is))
752 x2=x(1,ix2(is))
753 x3=x(1,ix3(is))
754 x4=x(1,ix4(is))
755 vxi = vfi(nin)%P(1,ii)
756 vx1=v(1,ix1(is))
757 vx2=v(1,ix2(is))
758 vx3=v(1,ix3(is))
759 vx4=v(1,ix4(is))
760 vx=max(max(vx1,vx2,vx3,vx4)-vxi,vxi-min(vx1,vx2,vx3,vx4))
761c PMAX_GAP is not used here (node not in contact)
762 tzinf = max(gapv(is)+dgapload,onep01*vx*dt1,edge_l(is))
763 tzinf = max(prec,tzinf)
764 xmin = min(x1,x2,x3,x4)-tzinf
765 xmax = max(x1,x2,x3,x4)+tzinf
766 IF (xmin<=xi.AND.xmax>=xi) THEN
767 cand_n(i) = -cand_n(i)
768 count_cand = count_cand+1
769 IF ((idtmins /= 2).AND.(idtmins_int == 0)) THEN
770 ct = ct + 1
771 IF(isedge_fi(nin)%P(ii)==1) ct = ct+3
772 ELSE
773CC-- Count of contact connections for AMS (+ additional connections related to contact on type2 - T2MAIN_SMS(1) > 1)
774 IF(isedge_fi(nin)%P(ii)==1) THEN
775 ct = ct + 4
776 IF (is2se_fi(nin)%P(1,ii) > 0) THEN
777 ie = is2se_fi(nin)%P(1,ii)
778 ELSE
779 ie = is2se_fi(nin)%P(2,ii)
780 ENDIF
781 DO kk=1,4
782 count_connec_sms = count_connec_sms + t2main_sms_fi(nin)%P(1,irtse_fi(nin)%P(kk,ie))*
783 . (t2main_sms(1,ix1(is))+t2main_sms(1,ix2(is))+t2main_sms(1,ix3(is))+t2main_sms(1,ix4(is)))
784 ENDDO
785 ELSE
786 ct = ct + 1
787 count_connec_sms = count_connec_sms + t2main_sms_fi(nin)%P(1,ii)*
788 . (t2main_sms(1,ix1(is))+t2main_sms(1,ix2(is))+t2main_sms(1,ix3(is))+t2main_sms(1,ix4(is)))
789 ENDIF
790 ENDIF
791 ELSE
792 time_sfi(nin)%P(ii)=zero
793 ENDIF
794 ENDIF
795 ENDDO
796 END IF
797 ELSE
798 CALL sync_data(nls2)
799 ENDIF
800 js = js + nseg
801 ENDDO
802c write(iout,*)'i24optcd 5'
803
804#include "lockon.inc"
805 lskyi_count=lskyi_count+count_cand*5
806 count_remslv(nin)=count_remslv(nin)+ct
807 lskyi_sms_new = lskyi_sms_new + count_connec_sms
808#include "lockoff.inc"
809C
810C ---------------------------------------------------------------------------
811C T24E2E TREATMENT for SMP coherency in force computation / Initialize ISPT2
812C This treatment was initially made in I24COR3 which is too late
813C ---------------------------------------------------------------------------
814C Care - SPMD Treatments are made in SPMD_EXCH_I24 due to communication
815C ---------------------------------------------------------------------------
816 IF (iedg4 > 0 .AND.nspmd == 1)THEN
817 DO i = nsnf,nsnl
818 ispt2(i)=0
819 ENDDO
820 CALL i24ispt2_ini_opttri(
821 1 nsnf ,nsnl ,nsv ,cand_n ,nsn ,irtse ,
822 2 is2se ,ispt2 ,isegpt ,irtlm ,nsne ,
823 3 nrtse ,iedg4 ,nin)
824 ENDIF
825
826 RETURN
827 END
i24ispt2_ini_opttri
subroutine i24ispt2_ini_opttri(jft, jlt, nsv, cand_n, nsn, irtse, is2se, ispt2, isegpt, irtlm, nsne, nrtse, iedg4, nin)
Definition i24cor3.F:893
sync_data
subroutine sync_data(ii)
Definition machine.F:381
i24optcd
subroutine i24optcd(nsv, cand_e, cand_n, x, i_stok, irect, gap_s, gap_m, v, icurv, stfn, itask, stf, nin, nsn, irtlm, time_s, mseglo, count_remslv, secnd_fr, nsnr, pene_old, stif_old, pmax_gap, edge_l2, iedge, igsti, mvoisin, icont_i, is2se, irtse, nsne, nrtse, is2pt, ispt2, isegpt, iedg4, t2main_sms, lskyi_sms_new, dgapload)
Definition i24optcd.F:44
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
debug_mod
Definition debug_mod.F:45
tri7box::time_sfi
type(real_pointer), dimension(:), allocatable time_sfi
Definition tri7box.F:542
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
tri7box::is2se_fi
type(int_pointer2), dimension(:), allocatable is2se_fi
Definition tri7box.F:536
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::irtse_fi
type(int_pointer2), dimension(:), allocatable irtse_fi
Definition tri7box.F:535
tri7box::gapfi
type(real_pointer), dimension(:), allocatable gapfi
Definition tri7box.F:449
tri7box::isedge_fi
type(int_pointer), dimension(:), allocatable isedge_fi
Definition tri7box.F:540
tri7box::xfi
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459
tri7box::pene_oldfi
type(real_pointer2), dimension(:), allocatable pene_oldfi
Definition tri7box.F:544
tri7box::icont_i_fi
type(int_pointer), dimension(:), allocatable icont_i_fi
Definition tri7box.F:532
tri7box::t2main_sms_fi
type(int_pointer2), dimension(:), allocatable t2main_sms_fi
Definition tri7box.F:558