OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25comp_2.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!|| i25comp_2 ../engine/source/interfaces/int25/i25comp_2.f
25!||--- called by ------------------------------------------------------
26!|| i25maind_2 ../engine/source/interfaces/int25/i25maind_2.F
27!||--- calls -----------------------------------------------------
28!|| i25cdcor3 ../engine/source/interfaces/int25/i25mainf.F
29!|| i25cor3_21 ../engine/source/interfaces/int25/i25cor3.F
30!|| i25cor3_22 ../engine/source/interfaces/int25/i25cor3.F
31!|| i25dst3_21 ../engine/source/interfaces/int25/i25dst3_21.F
32!|| i25dst3_22 ../engine/source/interfaces/int25/i25dst3_22.F
33!|| i25glob ../engine/source/interfaces/int25/i25dst3_1.F
34!|| i25glob_22 ../engine/source/interfaces/int25/i25dst3_22.F
35!|| my_barrier ../engine/source/system/machine.F
36!||--- uses -----------------------------------------------------
37!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
38!|| tri7box ../engine/share/modules/tri7box.F
39!||====================================================================
40 SUBROUTINE i25comp_2(
41 1 IPARI ,INTBUF_TAB ,X ,ITAB ,NIN ,
42 2 LINDMAX ,KINET ,JTASK ,NB_DST2,V ,
43 3 ICODT ,ISKEW )
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
330 END
331
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
i25comp_2
subroutine i25comp_2(ipari, intbuf_tab, x, itab, nin, lindmax, kinet, jtask, nb_dst2, v, icodt, iskew)
Definition i25comp_2.F:44
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
my_barrier
subroutine my_barrier
Definition machine.F:31