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 Rayon de courbure : calcul des normales nodales (normees)
144C IADM!=0 + Icurv!=0 non available (starter error).
145c----------------------------------------------------
146 IF(iadm/=0)THEN
147 END if!(IADM/=0)
148C-----------------------------------------------------------------------
149C
150C decoupage statique
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 candidats 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 et cand_e remplace par cand_n_n et 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 CALL MY_BARRIER
255C
256 IF (debug(3)>=1) THEN
257 nb_dst2 = nb_dst2 + i_stok
258 ENDIF
259
260 DO nft = 0 , i_stok - 1 , nvsiz
261 jlt = min( nvsiz, i_stok - nft )
262C preparation candidats retenus
263 CALL i25cdcor3(
264 1 jlt,index2(nft+1),intbuf_tab%CAND_OPT_E,intbuf_tab%CAND_OPT_N,
265 2 cand_e_n,cand_n_n )
266C cand_n et cand_e remplace par cand_n_n et cand_e_n
267 CALL i25cor3_22(
268 1 jlt ,x ,intbuf_tab%IRECTM,intbuf_tab%NSV ,cand_e_n ,
269 2 cand_n_n ,intbuf_tab%STFM ,intbuf_tab%STFNS,stif ,igap,
270 3 xi ,yi ,zi ,vxi ,vyi ,
271 4 vzi ,ix1 ,ix2 ,ix3 ,ix4 ,
272 5 nsvg ,nsn ,v ,
273 6 nin ,intbuf_tab%GAP_S,gaps ,intbuf_tab%ADMSR ,
274 . intbuf_tab%EDGE_BISECTOR,
275 7 xx ,yy ,zz ,
276 c vx1 ,vx2 ,vx3 ,vx4 ,
277 d vy1 ,vy2 ,vy3 ,vy4 ,
278 e vz1 ,vz2 ,vz3 ,vz4 ,
279 e nax ,nay ,naz ,
280 e nbx ,nby ,nbz ,
281 j intbuf_tab%GAP_M,gapm ,intbuf_tab%GAP_NM,gap_nm ,
282 l intbuf_tab%MVOISIN,nrtm ,intbuf_tab%MSEGTYP24,ishel ,
283 p mvoisa ,mvoisb ,intbuf_tab%GAP_SL,intbuf_tab%GAP_ML,gapmxl,
284 q intbuf_tab%LBOUND,ibounda,iboundb )
285
286C
287 CALL i25dst3_22(
288 1 jlt ,cand_n_n ,cand_e_n ,ishel ,
289 2 xx ,yy ,zz ,
290 3 xi ,yi ,zi ,
291 4 vx1 ,vx2 ,vx3 ,vx4 ,vxi ,
292 5 vy1 ,vy2 ,vy3 ,vy4 ,vyi ,
293 6 vz1 ,vz2 ,vz3 ,vz4 ,vzi ,
294 7 nin ,nsn ,ix1 ,
295 9 ix2 ,ix3 ,ix4 ,nsvg ,stif ,
296 a inacti ,intbuf_tab%MSEGLO,gaps ,gapm ,
297 b intbuf_tab%IRECTM,intbuf_tab%IRTLM ,intbuf_tab%TIME_S,gap_nm ,
298 c intbuf_tab%PENE_OLD,intbuf_tab%STIF_OLD,itab ,
299 d penmin ,eps ,intbuf_tab%ICONT_I,marge ,
300 e nax ,nay ,naz ,
301 e nbx ,nby ,nbz ,
302 j far ,pent ,
303 l subtria ,lb ,lc ,lbh ,lch ,
304 p mvoisa ,mvoisb,gapmxl ,ibounda,iboundb,
305 q intbuf_tab%VTX_BISECTOR ,drad ,dgapload)
306C
307 CALL i25glob_22(
308 1 jlt ,cand_n_n ,cand_e_n ,intbuf_tab%CAND_OPT_E,
309 2 nin ,nsn ,ix1 ,ix2 ,ix3 ,
310 3 ix4 ,nsvg ,stif ,inacti ,intbuf_tab%MSEGLO ,
311 4 intbuf_tab%IRTLM ,intbuf_tab%TIME_S ,itab ,subtria ,
312 5 far ,pent ,lb ,lc ,
313C 5 FAR ,PENT ,LBH ,LCH ,
314 6 index2(nft+1) ,intbuf_tab%FARM ,intbuf_tab%PENM ,
315 . intbuf_tab%LBM ,
316 7 intbuf_tab%LCM )
317C
318 ENDDO
319C-----------------------------------------------------------------------
320C
321 CALL my_barrier
322C
323C pmax_gap..
324#include "lockon.inc"
325 intbuf_tab%VARIABLES(23) = zero
326#include "lockoff.inc"
327C-----------------------------------------------------------------------
328 DEALLOCATE(index2)
329 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:907
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:2895
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:1169
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