OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25comp_2.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "warn_c.inc"
#include "task_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i25comp_2 (ipari, intbuf_tab, x, itab, nin, lindmax, kinet, jtask, nb_dst2, v, icodt, iskew)

Function/Subroutine Documentation

◆ i25comp_2()

subroutine i25comp_2 ( integer, dimension(npari,ninter) ipari,
type(intbuf_struct_) intbuf_tab,
x,
integer, dimension(*) itab,
integer nin,
integer lindmax,
integer, dimension(*) kinet,
integer jtask,
integer nb_dst2,
v,
integer, dimension(*) icodt,
integer, dimension(*) iskew )

Definition at line 40 of file i25comp_2.F.

44C=======================================================================
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE intbufdef_mod
49 USE tri7box
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54#include "comlock.inc"
55C-----------------------------------------------
56C G l o b a l P a r a m e t e r s
57C-----------------------------------------------
58#include "mvsiz_p.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com04_c.inc"
63#include "param_c.inc"
64#include "warn_c.inc"
65#include "task_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER NIN
70 INTEGER IPARI(NPARI,NINTER),
71 . ITAB(*), KINET(*), ICODT(*), ISKEW(*)
72 INTEGER NB_DST2,JTASK,LINDMAX
73C REAL
74 my_real
75 . x(3,*), v(3,*)
76 TYPE(INTBUF_STRUCT_) INTBUF_TAB
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER JD(50),KD(50), JFI, KFI,
81 . I, J, L, H, I_STOK, JLT_NEW, JLT , NFT,
82 . NSEG, IADM,
83 . IGAP, INACTI,
84 . NB_LOC, I_STOK_LOC,DEBUT,
85 . ILAGM, LENR, INTTH,
86 . I_STOK_GLO, MGLOB, MG, N, NN, IERROR
87 INTEGER LENT, MAXCC
88 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
89 . NSVG(MVSIZ), ISHEL(MVSIZ),
90 . CAND_N_N(MVSIZ),CAND_E_N(MVSIZ),SUBTRIA(MVSIZ),
91 . FAR(MVSIZ,4), KSLIDE(MVSIZ,4), MVOISN(MVSIZ,4),
92 . MVOISA(MVSIZ,4), MVOISB(MVSIZ,4), IBOUND(4,MVSIZ),
93 . IBOUNDA(4,MVSIZ), IBOUNDB(4,MVSIZ), ETYP(MVSIZ)
94 INTEGER, ALLOCATABLE, DIMENSION(:) :: INDEX2
95C REAL
96 my_real
97 . eps
98C-----------------------------------------------
99C REAL
100 my_real
101 . nnx(mvsiz,5), nny(mvsiz,5), nnz(mvsiz,5),
102 . nax(mvsiz,5), nay(mvsiz,5), naz(mvsiz,5),
103 . nbx(mvsiz,5), nby(mvsiz,5), nbz(mvsiz,5),
104 . xx(mvsiz,5), yy(mvsiz,5), zz(mvsiz,5),
105 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
106 . vx1(mvsiz), vx2(mvsiz), vx3(mvsiz), vx4(mvsiz),
107 . vy1(mvsiz), vy2(mvsiz), vy3(mvsiz), vy4(mvsiz),
108 . vz1(mvsiz), vz2(mvsiz), vz3(mvsiz), vz4(mvsiz),
109 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz),
110 . gapv(mvsiz),msi(mvsiz),
111 . nm1(mvsiz), nm2(mvsiz), nm3(mvsiz),
112 . tempi(mvsiz),phi(mvsiz),areasi(mvsiz), gaps(mvsiz), gapm(mvsiz),
113 . pent(mvsiz,4), lb(mvsiz,4), lc(mvsiz,4),
114 . lbh(mvsiz,4), lch(mvsiz,4), gap_nm(4,mvsiz),
115 . dist(mvsiz), gapmxl(mvsiz)
116 my_real
117 . rcurvi(mvsiz), anglmi(mvsiz), penmin,marge,drad,dgapload
118 INTEGER NRTMFT, NRTMLT, NMNFT, NMNLT
119 INTEGER ILEV,NRTM,NSN
120C-----------------------------------------------
121C
122 nrtm =ipari(4,nin)
123 nsn =ipari(5,nin)
124 IF(ipari(33,nin)==1) RETURN
125 igap =ipari(21,nin)
126 inacti=ipari(22,nin)
127C adaptive meshing
128 iadm =ipari(44,nin)
129 marge=intbuf_tab%VARIABLES(25)
130C heat interface
131 intth = ipari(47,nin)
132C
133 penmin = intbuf_tab%VARIABLES(38)
134 eps = intbuf_tab%VARIABLES(39)
135 drad = zero
136 IF(intth > 0) drad = intbuf_tab%VARIABLES(32)
137 dgapload = intbuf_tab%VARIABLES(46)
138
139 ilev = ipari(20,nin)
140 ALLOCATE(index2(lindmax))
141
142c----------------------------------------------------
143c radius of curvature: calculation of nodal normals (normalized)
144C IADM!=0 + Icurv!=0 non available (starter error).
145c----------------------------------------------------
146 IF(iadm/=0)THEN
147 END if!(IADM/=0)
148C-----------------------------------------------------------------------
149C
150C static decoupage
151C
152 i_stok_glo = intbuf_tab%I_STOK(2)
153C
154 nb_loc = i_stok_glo / nthread
155 IF (jtask==nthread) THEN
156 i_stok_loc = i_stok_glo-nb_loc*(nthread-1)
157 ELSE
158 i_stok_loc = nb_loc
159 ENDIF
160 debut = (jtask-1)*nb_loc
161
162 i_stok = 0
163C
164 DO i = jtask, i_stok_glo, nthread
165 n = intbuf_tab%CAND_OPT_N(i)
166 l = intbuf_tab%CAND_OPT_E(i)
167 mg= intbuf_tab%MSEGLO(l)
168 IF(n <= nsn)THEN
169C
170C candidates for sliding (IRTLM /= 0 and IRTLM /= MG) & non previously impacted (IRTLM == 0)
171 IF(intbuf_tab%IRTLM(4*(n-1)+1) > 0.AND.intbuf_tab%IRTLM(4*(n-1)+1)/=mg)THEN
172 i_stok = i_stok + 1
173 index2(i_stok) = i
174 ENDIF
175 ELSE
176 IF(irtlm_fi(nin)%P(1,n-nsn) > 0.AND.irtlm_fi(nin)%P(1,n-nsn)/=mg)THEN
177 i_stok = i_stok + 1
178 index2(i_stok) = i
179 ENDIF
180 END IF
181 ENDDO
182C
183 CALL my_barrier
184C
185 IF (debug(3)>=1) THEN
186 nb_dst2 = nb_dst2 + i_stok
187 ENDIF
188
189 DO nft = 0 , i_stok - 1 , nvsiz
190 jlt = min( nvsiz, i_stok - nft )
191C preparation CANDIDATES retenus
192 CALL i25cdcor3(
193 1 jlt,index2(nft+1),intbuf_tab%CAND_OPT_E,intbuf_tab%CAND_OPT_N,
194 2 cand_e_n,cand_n_n )
195C cand_n and cand_e replaced by cand_n_n and cand_e_n
196 CALL i25cor3_21(
197 1 jlt ,x ,intbuf_tab%IRECTM,intbuf_tab%NSV ,cand_e_n ,
198 2 cand_n_n ,intbuf_tab%STFM ,intbuf_tab%STFNS,stif ,igap ,
199 3 xi ,yi ,zi ,ix1 ,ix2 ,
200 4 ix3 ,ix4 ,nsvg ,nsn ,intbuf_tab%MSEGTYP24,
201 5 etyp ,nin ,intbuf_tab%GAP_S,gaps ,intbuf_tab%ADMSR ,
202 6 intbuf_tab%EDGE_BISECTOR,xx ,yy ,zz ,nnx ,
203 7 nny ,nnz ,intbuf_tab%GAP_M ,gapm ,intbuf_tab%GAP_NM ,
204 8 gap_nm ,intbuf_tab%ISLIDE,kslide ,intbuf_tab%MVOISIN,mvoisn ,
205 9 intbuf_tab%GAP_SL,intbuf_tab%GAP_ML,gapmxl,intbuf_tab%LBOUND,ibound )
206C
207 CALL i25dst3_21(
208 1 jlt ,cand_n_n ,cand_e_n ,nrtm ,xx ,
209 2 yy ,zz ,xi ,yi ,zi ,
210 3 nin ,nsn ,ix1 ,ix2 ,ix3 ,
211 4 ix4 ,nsvg ,stif ,inacti ,intbuf_tab%MSEGLO,
212 5 gaps ,gapm ,intbuf_tab%IRECTM,intbuf_tab%IRTLM ,intbuf_tab%TIME_S,
213 6 gap_nm ,itab ,nnx ,nny ,nnz ,
214 7 far ,pent ,dist ,lb ,lc ,
215 8 lbh ,lch ,kslide ,mvoisn ,gapmxl ,
216 9 ibound ,intbuf_tab%VTX_BISECTOR,etyp ,icodt ,iskew ,
217 a drad ,dgapload )
218C
219 CALL i25glob(
220 1 jlt ,cand_n_n ,cand_e_n ,
221 2 nin ,nsn ,ix1 ,ix2 ,ix3 ,
222 3 ix4 ,nsvg ,stif ,inacti ,intbuf_tab%MSEGLO ,
223 4 intbuf_tab%IRTLM ,intbuf_tab%TIME_S ,itab ,
224 5 far ,pent ,lbh ,lch ,
225C 5 FAR ,PENT ,LB ,LC ,
226 6 index2(nft+1) ,intbuf_tab%FARM ,intbuf_tab%PENM ,
227 . intbuf_tab%LBM ,
228 7 intbuf_tab%LCM )
229C
230 ENDDO
231C-----------------------------------------------------------------------
232
233 i_stok = 0
234C
235 DO i = jtask, i_stok_glo, nthread
236 n = intbuf_tab%CAND_OPT_N(i)
237 l = intbuf_tab%CAND_OPT_E(i)
238 mg= intbuf_tab%MSEGLO(l)
239 IF(n <= nsn)THEN
240C
241C candidates for sliding (IRTLM /= 0 and IRTLM /= MG) & non previously impacted (IRTLM == 0)
242 IF(intbuf_tab%IRTLM(4*(n-1)+1)<=0)THEN
243 i_stok = i_stok + 1
244 index2(i_stok) = i
245 ENDIF
246 ELSE
247 IF(irtlm_fi(nin)%P(1,n-nsn)<=0)THEN
248 i_stok = i_stok + 1
249 index2(i_stok) = i
250 ENDIF
251 END IF
252 ENDDO
253C
254C barrier is needed, because will IRTLM be updated in i25dst3_22
255 CALL my_barrier
256C
257 IF (debug(3)>=1) THEN
258 nb_dst2 = nb_dst2 + i_stok
259 ENDIF
260
261 DO nft = 0 , i_stok - 1 , nvsiz
262 jlt = min( nvsiz, i_stok - nft )
263C preparation CANDIDATES retenus
264 CALL i25cdcor3(
265 1 jlt,index2(nft+1),intbuf_tab%CAND_OPT_E,intbuf_tab%CAND_OPT_N,
266 2 cand_e_n,cand_n_n )
267C cand_n and cand_e replaced by cand_n_n and cand_e_n
268 CALL i25cor3_22(
269 1 jlt ,x ,intbuf_tab%IRECTM,intbuf_tab%NSV ,cand_e_n ,
270 2 cand_n_n ,intbuf_tab%STFM ,intbuf_tab%STFNS,stif ,igap,
271 3 xi ,yi ,zi ,vxi ,vyi ,
272 4 vzi ,ix1 ,ix2 ,ix3 ,ix4 ,
273 5 nsvg ,nsn ,v ,
274 6 nin ,intbuf_tab%GAP_S,gaps ,intbuf_tab%ADMSR ,
275 . intbuf_tab%EDGE_BISECTOR,
276 7 xx ,yy ,zz ,
277 c vx1 ,vx2 ,vx3 ,vx4 ,
278 d vy1 ,vy2 ,vy3 ,vy4 ,
279 e vz1 ,vz2 ,vz3 ,vz4 ,
280 e nax ,nay ,naz ,
281 e nbx ,nby ,nbz ,
282 j intbuf_tab%GAP_M,gapm ,intbuf_tab%GAP_NM,gap_nm ,
283 l intbuf_tab%MVOISIN,nrtm ,intbuf_tab%MSEGTYP24,ishel ,
284 p mvoisa ,mvoisb ,intbuf_tab%GAP_SL,intbuf_tab%GAP_ML,gapmxl,
285 q intbuf_tab%LBOUND,ibounda,iboundb )
286
287C
288 CALL i25dst3_22(
289 1 jlt ,cand_n_n ,cand_e_n ,ishel ,
290 2 xx ,yy ,zz ,
291 3 xi ,yi ,zi ,
292 4 vx1 ,vx2 ,vx3 ,vx4 ,vxi ,
293 5 vy1 ,vy2 ,vy3 ,vy4 ,vyi ,
294 6 vz1 ,vz2 ,vz3 ,vz4 ,vzi ,
295 7 nin ,nsn ,ix1 ,
296 9 ix2 ,ix3 ,ix4 ,nsvg ,stif ,
297 a inacti ,intbuf_tab%MSEGLO,gaps ,gapm ,
298 b intbuf_tab%IRECTM,intbuf_tab%IRTLM ,intbuf_tab%TIME_S,gap_nm ,
299 c intbuf_tab%PENE_OLD,intbuf_tab%STIF_OLD,itab ,
300 d penmin ,eps ,intbuf_tab%ICONT_I,marge ,
301 e nax ,nay ,naz ,
302 e nbx ,nby ,nbz ,
303 j far ,pent ,
304 l subtria ,lb ,lc ,lbh ,lch ,
305 p mvoisa ,mvoisb,gapmxl ,ibounda,iboundb,
306 q intbuf_tab%VTX_BISECTOR ,drad ,dgapload)
307C
308 CALL i25glob_22(
309 1 jlt ,cand_n_n ,cand_e_n ,intbuf_tab%CAND_OPT_E,
310 2 nin ,nsn ,ix1 ,ix2 ,ix3 ,
311 3 ix4 ,nsvg ,stif ,inacti ,intbuf_tab%MSEGLO ,
312 4 intbuf_tab%IRTLM ,intbuf_tab%TIME_S ,itab ,subtria ,
313 5 far ,pent ,lb ,lc ,
314C 5 FAR ,PENT ,LBH ,LCH ,
315 6 index2(nft+1) ,intbuf_tab%FARM ,intbuf_tab%PENM ,
316 . intbuf_tab%LBM ,
317 7 intbuf_tab%LCM )
318C
319 ENDDO
320C-----------------------------------------------------------------------
321C
322 CALL my_barrier
323C
324C pmax_gap..
325#include "lockon.inc"
326 intbuf_tab%VARIABLES(23) = zero
327#include "lockoff.inc"
328C-----------------------------------------------------------------------
329 DEALLOCATE(index2)
330 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
if
if(complex_arithmetic) id
i25cor3_21
subroutine i25cor3_21(jlt, x, irect, nsv, cand_e, cand_n, stf, stfn, stif, igap, xi, yi, zi, ix1, ix2, ix3, ix4, nsvg, nsn, msegtyp, etyp, nin, gap_s, gaps, admsr, nod_normal, xx, yy, zz, nnx, nny, nnz, gap_m, gapm, gapn_m, gapnm, islide, kslide, mvoisin, mvoisn, gap_s_l, gap_m_l, gapmxl, lbound, ibound)
Definition i25cor3.F:244
i25cor3_22
subroutine i25cor3_22(jlt, x, irect, nsv, cand_e, cand_n, stf, stfn, stif, igap, xi, yi, zi, vxi, vyi, vzi, ix1, ix2, ix3, ix4, nsvg, nsn, v, nin, gap_s, gaps, admsr, nod_normal, xx, yy, zz, vx1, vx2, vx3, vx4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, nax, nay, naz, nbx, nby, nbz, gap_m, gapm, gapn_m, gapnm, mvoisin, nrtm, msegtyp, ishel, mvoisa, mvoisb, gap_s_l, gap_m_l, gapmxl, lbound, ibounda, iboundb)
Definition i25cor3.F:473
i25glob
subroutine i25glob(jlt, cand_n, cand_e, nin, nsn, ix1, ix2, ix3, ix4, nsvg, stif, inacti, mseglo, irtlm, time_s, itab, far, pent, lb, lc, index, farm, penm, lbm, lcm)
Definition i25dst3_1.F:898
i25dst3_21
subroutine i25dst3_21(jlt, cand_n, cand_e, nrtm, xx, yy, zz, xi, yi, zi, nin, nsn, ix1, ix2, ix3, ix4, nsvg, stif, inacti, mseglo, gaps, gapm, irect, irtlm, time_s, gap_nm, itab, nnx, nny, nnz, far, pent, dist, lb, lc, lbp, lcp, kslide, mvoisn, gapmxl, ibound, vtx_bisector, etyp, icodt, iskew, drad, dgapload)
Definition i25dst3_21.F:41
i25glob_22
subroutine i25glob_22(jlt, cand_n_n, cand_e_n, cand_e, nin, nsn, ix1, ix2, ix3, ix4, nsvg, stif, inacti, mseglo, irtlm, time_s, itab, subtria, far, pent, lb, lc, index, farm, penm, lbm, lcm)
Definition i25dst3_22.F:3021
i25dst3_22
subroutine i25dst3_22(jlt, cand_n, cand_e, ishel, xx, yy, zz, xi, yi, zi, vx1, vx2, vx3, vx4, vxi, vy1, vy2, vy3, vy4, vyi, vz1, vz2, vz3, vz4, vzi, nin, nsn, ix1, ix2, ix3, ix4, nsvg, stif, inacti, mseglo, gaps, gapm, irect, irtlm, time_s, gap_nm, pene_old, stif_old, itab, penmin, eps0, icont_i, marge, nax, nay, naz, nbx, nby, nbz, far, pent, subtria, lbs, lcs, lbp, lcp, mvoisa, mvoisb, gapmxl, ibounda, iboundb, vtx_bisector, drad, dgapload)
Definition i25dst3_22.F:53
i25cdcor3
subroutine i25cdcor3(jlt, index, cand_e, cand_n, cand_e_n, cand_n_n)
Definition i25mainf.F:1170
min
#define min(a, b)
Definition macros.h:20
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
my_barrier
subroutine my_barrier
Definition machine.F:31