OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25optcd.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 ../engine/source/interfaces/intsort/i25optcd.F
25!||--- called by ------------------------------------------------------
26!|| i25main_opt_tri ../engine/source/interfaces/intsort/i25main_opt_tri.F
27!||--- calls -----------------------------------------------------
28!|| my_barrier ../engine/source/system/machine.F
29!|| sync_data ../engine/source/system/machine.F
30!||--- uses -----------------------------------------------------
31!|| tri7box ../engine/share/modules/tri7box.F
32!||====================================================================
33 SUBROUTINE i25optcd(
34 1 NSV ,CAND_E ,CAND_N ,X ,I_STOK ,
35 2 IRECT ,GAP_S ,GAP_M ,V ,ICURV ,
36 3 STFN ,ITASK ,STF ,NIN ,NSN ,
37 4 IRTLM ,TIME_S ,MSEGLO ,COUNT_REMSLV,ITAB ,
38 5 SECND_FR,NSNR ,PENE_OLD,STIF_OLD ,MSEGTYP ,
39 6 NRTM ,PMAX_GAP,I_OPT_STOK,CAND_OPT_E,CAND_OPT_N ,
40 7 SIZOPT ,IGAP ,GAP_S_L ,GAP_M_L ,DRAD ,
41 8 DGAPLOAD,ICONT_I)
42C===============================================================
43C M o d u l e s
44C-----------------------------------------------
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 C o m m o n B l o c k s
57C-----------------------------------------------
58#include "scr05_c.inc"
59#include "com01_c.inc"
60#include "com08_c.inc"
61#include "param_c.inc"
62#include "task_c.inc"
63#include "parit_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER NSNR,I_STOK,NIN ,ITASK, NSN, ICURV, I_OPT_STOK, NRTM,
68 . IGAP, IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
69 . IRTLM(4,NSN),MSEGLO(*),COUNT_REMSLV(*), ITAB(*),
70 . MSEGTYP(*), CAND_OPT_E(*), CAND_OPT_N(*), SIZOPT
71 INTEGER , INTENT(INOUT) :: ICONT_I(NSN)
72 my_real , INTENT(IN) :: DGAPLOAD ,DRAD
73 my_real
74 . GAP,PMAX_GAP,
75 . x(3,*),gap_s(*),gap_m(*),stfn(*),stf(*),
76 . v(3,*),secnd_fr(6,*),time_s(*),
77 . pene_old(5,nsn),stif_old(2,nsn),
78 . gap_s_l(*),gap_m_l(*)
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82 INTEGER I,L,IS,JS,LS,NLS,NLT,NSEG,NLS2,SG,FIRST,LAST,MSEG,NLF,
83 . MG,II,N,KLEAVE, ISH, NSNRF,NSNRL,NSNF,NSNL
84 INTEGER LIST(MVSIZ),IG(MVSIZ),IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),
85 . IX4(MVSIZ), LISTI(MVSIZ)
86 my_real
87 . XI,X1,X2,X3,X4,YI,Y1,Y2,Y3,Y4,ZI,Z1,Z2,Z3,Z4,
88 . XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX,V12,V22,V32,V42
89 my_real
90 . gapv(mvsiz),prec
91 my_real
92 . x0,y0,z0,xxx,yyy,zzz,curv_max,tzinf,vx,vy,vz,vv,
93 . vxi,vyi,vzi,
94 . vx1,vx2,vx3,vx4,vy1,vy2,vy3,vy4,vz1,vz2,vz3,vz4
95
96C-----------------------------------------------
97 IF (iresp.EQ.1) THEN
98 prec = (seven+half)*em06
99 ELSE
100 prec = em8
101 ENDIF
102C------
103C
104C CONT_I contains Starter infos, it must be flushed when IRTLM(1,xxx) is no more Zero.
105C
106
107 nsnf = 1 + itask*nsn / nthread
108 nsnl = (itask+1)*nsn / nthread
109 DO i = nsnf,nsnl
110 IF(irtlm(1,i)/=0) icont_i(i)=0
111 ENDDO
112
113 nsnrf = 1 + itask*nsnr / nthread
114 nsnrl = (itask+1)*nsnr / nthread
115
116 DO i=nsnrf,nsnrl
117 IF(irtlm_fi(nin)%P(1,i)/=0) icont_i_fi(nin)%P(i)=0
118 ENDDO
119
120 mseg = nvsiz
121 first = 1 + i_stok*itask / nthread
122 last = i_stok*(itask+1) / nthread
123 js = first-1
124 DO sg = first,last,mseg
125 nseg = min(mseg,last-js)
126 nls=0
127
128 IF(nspmd>1) THEN
129C
130C Partage cand_n local / frontiere
131C
132 nls = 0
133 nls2 = nseg+1
134 DO is = 1, nseg
135 i=js+is
136 IF(cand_n(i)<=nsn)THEN
137 nls=nls+1
138 listi(nls)=is
139 ELSE
140 nls2=nls2-1
141 listi(nls2) = is
142 ENDIF
143 ENDDO
144 DO ls = 1, nls
145 is = listi(ls)
146 i=js+is
147 gapv(is)=gap_s(cand_n(i)) + gap_m(cand_e(i))
148 IF(igap==3)
149 . gapv(is)=min(gapv(is),
150 . gap_s_l(cand_n(i))+gap_m_l(cand_e(i)))
151 ENDDO
152 ELSE
153 nls = nseg
154 DO is=1,nseg
155 i=js+is
156 gapv(is)=gap_s(cand_n(i)) + gap_m(cand_e(i))
157 IF(igap==3)
158 . gapv(is)=min(gapv(is),
159 . gap_s_l(cand_n(i))+gap_m_l(cand_e(i)))
160 listi(is)=is
161 ENDDO
162 ENDIF
163C
164 nlf = 1
165 nlt = nls
166 nls=0
167 DO ls = nlf, nlt
168C conserver LISTI et LIST pour optimiser le code genere (IA64)
169 is = listi(ls)
170 i=js+is
171 l = cand_e(i)
172 n = cand_n(i)
173 mg = irtlm(1,n)
174 kleave=irtlm(3,n)
175 IF(stfn(n)/=zero.AND.stf(l)>zero.AND.mg==0.AND.kleave/=-1)THEN
176c else, keep only candidates wrt non impacted nodes
177 ig(is) = nsv(cand_n(i))
178 zi = x(3,ig(is))
179 ix1(is)=irect(1,l)
180 z1=x(3,ix1(is))
181 ix2(is)=irect(2,l)
182 z2=x(3,ix2(is))
183 ix3(is)=irect(3,l)
184 z3=x(3,ix3(is))
185 ix4(is)=irect(4,l)
186 z4=x(3,ix4(is))
187 vzi = v(3,ig(is))
188 vz1=v(3,ix1(is))
189 vz2=v(3,ix2(is))
190 vz3=v(3,ix3(is))
191 vz4=v(3,ix4(is))
192 vz=max(max(vz1,vz2,vz3,vz4)-vzi,vzi-min(vz1,vz2,vz3,vz4))
193C
194 tzinf = max(max(gapv(is)+dgapload,drad),onep01*vz*dt1)
195 tzinf = max(prec,tzinf)
196 zmin = min(z1,z2,z3,z4)-tzinf
197 zmax = max(z1,z2,z3,z4)+tzinf
198 IF (zmin<=zi.AND.zmax>=zi) THEN
199 nls=nls+1
200 list(nls)=is
201 ENDIF
202 ENDIF
203 ENDDO
204C
205 nlt=nls
206 nls=0
207 DO ls=nlf,nlt
208 is=list(ls)
209 i=js+is
210 yi=x(2,ig(is))
211 y1=x(2,ix1(is))
212 y2=x(2,ix2(is))
213 y3=x(2,ix3(is))
214 y4=x(2,ix4(is))
215 vyi = v(2,ig(is))
216 vy1=v(2,ix1(is))
217 vy2=v(2,ix2(is))
218 vy3=v(2,ix3(is))
219 vy4=v(2,ix4(is))
220 vy=max(max(vy1,vy2,vy3,vy4)-vyi,vyi-min(vy1,vy2,vy3,vy4))
221C
222 tzinf = max(max(gapv(is)+dgapload,drad),onep01*vy*dt1)
223 tzinf = max(prec,tzinf)
224 ymin = min(y1,y2,y3,y4)-tzinf
225 ymax = max(y1,y2,y3,y4)+tzinf
226 IF (ymin<=yi.AND.ymax>=yi) THEN
227 nls=nls+1
228 list(nls)=is
229 ENDIF
230 ENDDO
231C
232#include "vectorize.inc"
233 DO ls=nlf,nls
234 is=list(ls)
235 i=js+is
236 xi=x(1,ig(is))
237 x1=x(1,ix1(is))
238 x2=x(1,ix2(is))
239 x3=x(1,ix3(is))
240 x4=x(1,ix4(is))
241 vxi = v(1,ig(is))
242 vx1=v(1,ix1(is))
243 vx2=v(1,ix2(is))
244 vx3=v(1,ix3(is))
245 vx4=v(1,ix4(is))
246 vx=max(max(vx1,vx2,vx3,vx4)-vxi,vxi-min(vx1,vx2,vx3,vx4))
247C
248 tzinf = max(max(gapv(is)+dgapload,drad),onep01*vx*dt1)
249 tzinf = max(prec,tzinf)
250 xmin = min(x1,x2,x3,x4)-tzinf
251 xmax = max(x1,x2,x3,x4)+tzinf
252 IF (xmin<=xi.AND.xmax>=xi) THEN
253 cand_n(i) = -cand_n(i)
254 ENDIF
255 ENDDO
256
257C-------------------------------------------------------------
258 IF(nspmd>1)THEN
259 nlf = nls2
260 nlt = nseg
261 DO ls = nlf, nlt
262 is = listi(ls)
263 i=js+is
264 gapv(is)=gapfi(nin)%P(cand_n(i)-nsn) + gap_m(cand_e(i))
265 IF(igap==3)
266 . gapv(is)=min(gapv(is),
267 . gap_lfi(nin)%P(cand_n(i)-nsn)+gap_m_l(cand_e(i)))
268 ENDDO
269C---------
270 nls=0
271 DO ls = nlf, nlt
272 is = listi(ls)
273 i=js+is
274 ii = cand_n(i)-nsn
275 l = cand_e(i)
276 mg = irtlm_fi(nin)%P(1,ii)
277 kleave = irtlm_fi(nin)%P(3,ii)
278 IF(stifi(nin)%P(ii)/=zero.AND.stf(l)>zero.AND.mg==0.AND.kleave/=-1)THEN
279 zi = xfi(nin)%P(3,ii)
280 ix1(is)=irect(1,l)
281 z1=x(3,ix1(is))
282 ix2(is)=irect(2,l)
283 z2=x(3,ix2(is))
284 ix3(is)=irect(3,l)
285 z3=x(3,ix3(is))
286 ix4(is)=irect(4,l)
287 z4=x(3,ix4(is))
288 vzi = vfi(nin)%P(3,ii)
289 vz1=v(3,ix1(is))
290 vz2=v(3,ix2(is))
291 vz3=v(3,ix3(is))
292 vz4=v(3,ix4(is))
293 vz=max(max(vz1,vz2,vz3,vz4)-vzi,vzi-min(vz1,vz2,vz3,vz4))
294C
295 tzinf = max(max(gapv(is)+dgapload,drad),onep01*vz*dt1)
296 tzinf = max(prec,tzinf)
297 zmin = min(z1,z2,z3,z4)-tzinf
298 zmax = max(z1,z2,z3,z4)+tzinf
299 IF (zmin<=zi.AND.zmax>=zi) THEN
300 nls=nls+1
301 list(nls)=is
302 ENDIF
303 ENDIF
304 ENDDO
305C
306 nlf=1
307 nlt=nls
308 nls=0
309 DO ls=nlf,nlt
310 is=list(ls)
311 i=js+is
312 ii = cand_n(i)-nsn
313 yi=xfi(nin)%P(2,ii)
314 y1=x(2,ix1(is))
315 y2=x(2,ix2(is))
316 y3=x(2,ix3(is))
317 y4=x(2,ix4(is))
318 vyi = vfi(nin)%P(2,ii)
319 vy1=v(2,ix1(is))
320 vy2=v(2,ix2(is))
321 vy3=v(2,ix3(is))
322 vy4=v(2,ix4(is))
323 vy=max(max(vy1,vy2,vy3,vy4)-vyi,vyi-min(vy1,vy2,vy3,vy4))
324C
325 tzinf = max(max(gapv(is)+dgapload,drad),onep01*vy*dt1)
326 tzinf = max(prec,tzinf)
327 ymin = min(y1,y2,y3,y4)-tzinf
328 ymax = max(y1,y2,y3,y4)+tzinf
329 IF (ymin<=yi.AND.ymax>=yi) THEN
330 nls=nls+1
331 list(nls)=is
332 ENDIF
333 ENDDO
334C
335#include "vectorize.inc"
336 DO ls=nlf,nls
337 is=list(ls)
338 i=js+is
339 ii = cand_n(i)-nsn
340 xi = xfi(nin)%P(1,ii)
341 x1=x(1,ix1(is))
342 x2=x(1,ix2(is))
343 x3=x(1,ix3(is))
344 x4=x(1,ix4(is))
345 vxi = vfi(nin)%P(1,ii)
346 vx1=v(1,ix1(is))
347 vx2=v(1,ix2(is))
348 vx3=v(1,ix3(is))
349 vx4=v(1,ix4(is))
350 vx=max(max(vx1,vx2,vx3,vx4)-vxi,vxi-min(vx1,vx2,vx3,vx4))
351C
352 tzinf = max(max(gapv(is)+dgapload,drad),onep01*vx*dt1)
353 tzinf = max(prec,tzinf)
354 xmin = min(x1,x2,x3,x4)-tzinf
355 xmax = max(x1,x2,x3,x4)+tzinf
356 IF (xmin<=xi.AND.xmax>=xi) THEN
357 cand_n(i) = -cand_n(i)
358 ENDIF
359 ENDDO
360 ELSE
361 CALL sync_data(nls2)
362 ENDIF
363 js = js + nseg
364 ENDDO
365C
366C Compact candidates
367C
368 CALL my_barrier
369C
370!$OMP SINGLE
371 DO i=1,i_stok
372 IF(cand_n(i)<0)THEN
373 cand_n(i) = -cand_n(i)
374 i_opt_stok= i_opt_stok + 1
375 IF(i_opt_stok <= sizopt)THEN
376 cand_opt_n(i_opt_stok)= cand_n(i)
377 cand_opt_e(i_opt_stok)= cand_e(i)
378 END IF
379 END IF
380 END DO
381 IF(i_opt_stok <= sizopt)THEN
382 lskyi_count=lskyi_count+i_opt_stok*5
383 count_remslv(nin)=count_remslv(nin)+i_opt_stok
384 END IF
385C initialize PMAX_GAP to Zero for future treatments in force computation.
386 pmax_gap = zero
387!$OMP END SINGLE
388C
389c print *,'i_stok',ispmd+1,i_stok,i_opt_stok
390 RETURN
391 END
sync_data
subroutine sync_data(ii)
Definition machine.F:381
i25optcd
subroutine i25optcd(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, itab, secnd_fr, nsnr, pene_old, stif_old, msegtyp, nrtm, pmax_gap, i_opt_stok, cand_opt_e, cand_opt_n, sizopt, igap, gap_s_l, gap_m_l, drad, dgapload, icont_i)
Definition i25optcd.F:42
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::gap_lfi
type(real_pointer), dimension(:), allocatable gap_lfi
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
tri7box::icont_i_fi
type(int_pointer), dimension(:), allocatable icont_i_fi
Definition tri7box.F:532
my_barrier
subroutine my_barrier
Definition machine.F:31