OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7main_lmult.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!|| i7main_lmult ../engine/source/interfaces/int07/i7main_lmult.F
25!||--- called by ------------------------------------------------------
26!|| lag_mult ../engine/source/tools/lagmul/lag_mult.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| i7cdcor3 ../engine/source/interfaces/int07/i7cdcor3.F
31!|| i7cor3 ../engine/source/interfaces/int07/i7cor3.F
32!|| i7dst3 ../engine/source/interfaces/int07/i7dst3.F
33!|| i7lagm ../engine/source/interfaces/int07/i7lagm.F
34!|| my_barrier ../engine/source/system/machine.F
35!||--- uses -----------------------------------------------------
36!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
37!|| message_mod ../engine/share/message_module/message_mod.F
38!||====================================================================
39 SUBROUTINE i7main_lmult(
40 1 NIN ,IPARI ,INTBUF_TAB,X ,
41 2 V ,A ,ITASK ,MS ,
42 3 IADLL ,LLL ,JLL ,SLL ,XLL ,
43 4 N_MUL_MX ,NKMAX ,ITAB ,INDEX2 ,NB_JLT ,
44 5 NB_JLT_NEW,NB_STOK_N ,NEWFRONT,ICONTACT,ITAG ,
45 6 XTAG ,COMNTAG ,KINET )
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE message_mod
50 USE intbufdef_mod
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C
54C-------------------------------------------------------------------------------
55C NOM DIMENSION DESCRIPTION E/S
56C-------------------------------------------------------------------------------
57C
58C NIN 1 NUMERO INTERFACE E
59C
60C IPARI NPARI,NINTER PARAMETRES D'INTERFACE E
61C
62C X 3,NUMNOD COORDONNEES E
63C
64C V 3,NUMNOD VITESSES E
65C
66C EMINX 6*NME<6*NUMELS MIN MAX DE CHAQUE ELEMENT TMP_GLOBAL
67C
68C
69C-----------------------------------------------
70C I m p l i c i t T y p e s
71C-----------------------------------------------
72#include "implicit_f.inc"
73C-----------------------------------------------
74C G l o b a l P a r a m e t e r s
75C-----------------------------------------------
76#include "mvsiz_p.inc"
77C-----------------------------------------------
78C C o m m o n B l o c k s
79C-----------------------------------------------
80#include "com04_c.inc"
81#include "com08_c.inc"
82#include "param_c.inc"
83#include "task_c.inc"
84#include "warn_c.inc"
85C-----------------------------------------------
86C D u m m y A r g u m e n t s
87C-----------------------------------------------
88 INTEGER NIN,ITASK ,N_MUL_MX ,NKMAX ,
89 . NB_JLT,NB_JLT_NEW,NB_STOK_N,NEWFRONT
90 INTEGER IPARI(NPARI,NINTER), KINET(*),
91 . IADLL(*) ,LLL(*) ,JLL(*) ,SLL(*) ,ICONTACT(*),
92 . ITAB(*), INDEX2(*), ITAG(*), COMNTAG(*)
93C REAL
94 my_real
95 . x(3,*), v(3,*), a(3,*), ms(*),
96 . xll(*), xtag(*)
97
98 TYPE(intbuf_struct_) INTBUF_TAB(*)
99C-----------------------------------------------
100C L o c a l V a r i a b l e s
101C-----------------------------------------------
102 INTEGER I_STOK_GLOB,NSN,NME,NAD,EAD,
103 . NME_T,ESH_T,IGN,IGE,MULTIMP,NOINT,I,MX_CAND,NTY,IVIS2,
104 . igap,inacti,ibag,i_stok, i_stok_loc, jlt_new,
105 . jlt, nft,debut,nbid,nb_loc,jtask, igsti,icurv,iadm
106 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
107 . NSVG(MVSIZ), CN_LOC(MVSIZ),CE_LOC(MVSIZ),
108 . cand_n_n(mvsiz),cand_e_n(mvsiz),kini(mvsiz),ibid
109C REAL
110 my_real
111 . startt, stopt,gap,gapmin,maxbox,minbox,bid,
112 . kmin, kmax, gapmax
113 my_real
114 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
115 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
116 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
117 . lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
118 . lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
119 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(mvsiz),
120 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
121 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
122 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
123 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
124 . n1(mvsiz), n2(mvsiz), n3(mvsiz), pene(mvsiz),
125 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
126 . gapv(mvsiz),vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz)
127 my_real
128 . nnx1(mvsiz), nnx2(mvsiz), nnx3(mvsiz), nnx4(mvsiz),
129 . nny1(mvsiz), nny2(mvsiz), nny3(mvsiz), nny4(mvsiz),
130 . nnz1(mvsiz), nnz2(mvsiz), nnz3(mvsiz), nnz4(mvsiz),
131 . cmaj(mvsiz)
132 my_real
133 . drad, drad2
134C-----------------------------------------------
135C S o u r c e L i n e s
136C-----------------------------------------------
137 IF(ipari(33,nin)==0)RETURN
138C -------------------
139 CALL my_barrier
140C -------------------
141 DO i = itask+1,numnod,nthread
142 itag(i) = 0
143 xtag(i) = zero
144 ENDDO
145C -------------------
146 CALL my_barrier
147C -------------------
148 jtask=itask+1
149C
150 nbid=0
151 bid=zero
152 ibid = 0
153C
154 nsn =ipari(5,nin)
155 nty =ipari(7,nin)
156 ivis2 =ipari(14,nin)
157 noint =ipari(15,nin)
158 igap =ipari(21,nin)
159 inacti=ipari(22,nin)
160 ibag =ipari(32,nin)
161 igsti=ipari(34,nin)
162 icurv =0
163 iadm =ipari(44,nin)
164 startt=intbuf_tab(nin)%VARIABLES(3)
165 stopt =intbuf_tab(nin)%VARIABLES(11)
166 IF(startt>tt) RETURN
167 IF(tt>stopt) RETURN
168 gap =intbuf_tab(nin)%VARIABLES(2)
169 gapmin=intbuf_tab(nin)%VARIABLES(13)
170C
171c IF(NTY==7)THEN
172C
173 i_stok = intbuf_tab(nin)%I_STOK(1)
174 maxbox = intbuf_tab(nin)%VARIABLES(9)
175 minbox = intbuf_tab(nin)%VARIABLES(12)
176 gapmax=intbuf_tab(nin)%VARIABLES(16)
177 kmin =intbuf_tab(nin)%VARIABLES(17)
178 kmax =intbuf_tab(nin)%VARIABLES(18)
179 drad = zero
180 drad2 = zero
181 IF(nty==7)THEN
182 drad = intbuf_tab(nin)%VARIABLES(32)
183 drad2 = drad*drad
184 ENDIF
185C cette partie est effectuee en // apres le calcul des forces des elem.
186C decoupage statique
187 nb_loc = i_stok / nthread
188 IF (jtask==nthread) THEN
189 i_stok_loc = i_stok-nb_loc*(nthread-1)
190 ELSE
191 i_stok_loc = nb_loc
192 ENDIF
193 debut = (jtask-1)*nb_loc
194 i_stok = 0
195C recalcul du istok
196 IF (inacti==5.OR.inacti==6)THEN
197 DO i = debut+1, debut+i_stok_loc
198 IF(intbuf_tab(nin)%CAND_N(i)<0) THEN
199Ctmp+++
200 IF(i_stok + 1>4*numnod) THEN
201 CALL ancmsg(msgid=97,anmode=aninfo)
202 CALL arret(2)
203 ENDIF
204Ctmp---
205 i_stok = i_stok + 1
206 index2(i_stok) = i
207C inbuf == cand_n
208 intbuf_tab(nin)%CAND_N(i) = -intbuf_tab(nin)%CAND_N(i)
209 ELSE
210C remise a 0 de cand_p
211 intbuf_tab(nin)%CAND_P(i) = zero
212 ENDIF
213 ENDDO
214 ELSE
215 DO i = debut+1, debut+i_stok_loc
216 IF(intbuf_tab(nin)%CAND_N(i)<0) THEN
217Ctmp+++
218 IF(i_stok + 1>4*numnod) THEN
219 CALL ancmsg(msgid=97,anmode=aninfo)
220 CALL arret(2)
221 ENDIF
222Ctmp---
223 i_stok = i_stok + 1
224 index2(i_stok) = i
225C inbuf == cand_n
226 intbuf_tab(nin)%CAND_N(i) = -intbuf_tab(nin)%CAND_N(i)
227 ENDIF
228 ENDDO
229 ENDIF
230C
231 IF (debug(3)>=1) THEN
232 nb_jlt = nb_jlt + i_stok_loc
233 nb_stok_n = nb_stok_n + i_stok
234 ENDIF
235C
236 DO nft = 0 , i_stok - 1 , nvsiz
237 jlt = min( nvsiz, i_stok - nft )
238C preparation candidats retenus
239 CALL i7cdcor3(
240 1 jlt,index2(nft+1),intbuf_tab(nin)%CAND_E,intbuf_tab(nin)%CAND_N,
241 2 cand_e_n,cand_n_n)
242C cand_n et cand_e remplace par cand_n_n et cand_e_n
243 CALL i7cor3(
244 1 jlt ,x ,intbuf_tab(nin)%IRECTM,intbuf_tab(nin)%NSV,
245 . cand_e_n,
246 2 cand_n_n ,intbuf_tab(nin)%STFM,intbuf_tab(nin)%STFNS,x1 ,x2 ,
247 3 x3 ,x4 ,y1 ,y2 ,y3 ,
248 4 y4 ,z1 ,z2 ,z3 ,z4 ,
249 5 xi ,yi ,zi ,stif ,ix1 ,
250 6 ix2 ,ix3 ,ix4 ,nsvg ,igap ,
251 7 gap ,intbuf_tab(nin)%GAP_S,intbuf_tab(nin)%GAP_M,gapv,
252 9 ms ,vxi ,vyi ,
253 a vzi ,msi ,nsn ,v ,kinet ,
254 b kini ,nty ,nin ,igsti ,kmin ,
255 c kmax ,gapmax ,gapmin ,iadm ,bid ,
256 d bid ,bid ,bid ,ibid ,bid ,
257 e bid ,bid ,bid ,ibid ,bid ,
258 f ibid ,ibid ,ibid ,intbuf_tab(nin)%GAP_SL,
259 . intbuf_tab(nin)%GAP_ML,
260 g ibid ,ibid ,ibid ,ibid ,ibid ,
261 h ibid ,ibid ,bid ,ibid ,bid )
262 jlt_new = 0
263 CALL i7dst3(
264 1 jlt ,cand_n_n,cand_e_n,cn_loc, ce_loc,
265 2 x1 ,x2 ,x3 ,x4 ,y1 ,
266 3 y2 ,y3 ,y4 ,z1 ,z2 ,
267 4 z3 ,z4 ,xi ,yi ,zi ,
268 5 nx1 ,nx2 ,nx3 ,nx4 ,ny1 ,
269 6 ny2 ,ny3 ,ny4 ,nz1 ,nz2 ,
270 7 nz3 ,nz4 ,lb1 ,lb2 ,lb3 ,
271 8 lb4 ,lc1 ,lc2 ,lc3 ,lc4 ,
272 9 p1 ,p2 ,p3 ,p4 ,ix1 ,
273 a ix2 ,ix3 ,ix4 ,nsvg ,stif ,
274 b jlt_new,gapv ,inacti ,intbuf_tab(nin)%CAND_P,
275 c index2(nft+1),vxi ,vyi ,
276 d vzi ,msi ,kini ,icurv ,intbuf_tab(nin)%IRECTM,
277 e nnx1 ,nnx2 ,nnx3 ,nnx4 ,nny1 ,
278 f nny2 ,nny3 ,nny4 ,nnz1 ,nnz2 ,
279 g nnz3 ,nnz4 ,bid ,iadm ,bid ,
280 h bid ,ibid ,bid ,bid ,bid ,
281 i ibid ,ibid ,cmaj ,drad2 ,
282 j ibid ,ibid ,
283 k ibid ,ibid ,ibid ,intbuf_tab(nin)%CAND_F,
284 l ibid ,ibid ,bid ,bid )
285
286
287 jlt = jlt_new
288 IF(jlt_new/=0) THEN
289 ipari(29,nin) = 1
290 IF (debug(3)>=1)
291 . nb_jlt_new = nb_jlt_new + jlt_new
292 CALL i7lagm(lll,jll,sll ,xll ,iadll ,
293 2 n_mul_mx,itask ,nin ,nkmax ,
294 3 jlt ,a ,v ,itag ,xtag ,
295 4 gap ,noint ,intbuf_tab(nin)%STFNS,itab ,cn_loc ,
296 5 nx1 ,nx2 ,nx3 ,nx4 ,ny1 ,
297 6 ny2 ,ny3 ,ny4 ,nz1 ,nz2 ,
298 7 nz3 ,nz4 ,lb1 ,lb2 ,lb3 ,
299 8 lb4 ,lc1 ,lc2 ,lc3 ,lc4 ,
300 9 p1 ,p2 ,p3 ,p4 ,
301 a ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
302 b gapv ,newfront,ibag ,icontact,stif ,
303 c comntag ,iadm )
304 ENDIF
305 ENDDO
306C
307 RETURN
308 END
my_real
#define my_real
Definition cppsort.cpp:32
i7cdcor3
subroutine i7cdcor3(jlt, index, cand_e, cand_n, cand_e_n, cand_n_n)
Definition i7cdcor3.F:38
i7lagm
subroutine i7lagm(lll, jll, sll, xll, iadll, n_mul_mx, itask, nint, nkmax, jlt, a, v, itag, xtag, gap, noint, stfn, itab, cn_loc, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, ix1, ix2, ix3, ix4, nsvg, gapv, newfront, ibag, icontact, stif, comntag, iadm)
Definition i7lagm.F:45
i7main_lmult
subroutine i7main_lmult(nin, ipari, intbuf_tab, x, v, a, itask, ms, iadll, lll, jll, sll, xll, n_mul_mx, nkmax, itab, index2, nb_jlt, nb_jlt_new, nb_stok_n, newfront, icontact, itag, xtag, comntag, kinet)
Definition i7main_lmult.F:46
min
#define min(a, b)
Definition macros.h:20
message_mod
Definition message_mod.F:1249
i7cor3
subroutine i7cor3(x, irect, nsv, cand_e, cand_n, stf, stfn, gapv, igap, gap, gap_s, gap_m, istf, gapmin, gapmax, gap_s_l, gap_m_l, drad, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, dgapload, last)
Definition i7cor3.F:43
i7dst3
subroutine i7dst3(ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, last)
Definition i7dst3.F:46
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87
my_barrier
subroutine my_barrier
Definition machine.F:31