OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i23mainf.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!|| i23mainf ../engine/source/interfaces/int23/i23mainf.F
25!||--- called by ------------------------------------------------------
26!|| intfop2 ../engine/source/interfaces/interf/intfop2.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| finter ../engine/source/tools/curve/finter.F
31!|| i23cor3 ../engine/source/interfaces/int23/i23cor3.F
32!|| i23dst3 ../engine/source/interfaces/int23/i23dst3.F
33!|| i23for3 ../engine/source/interfaces/int23/i23for3.F
34!|| i7cdcor3 ../engine/source/interfaces/int07/i7cdcor3.F
35!|| my_barrier ../engine/source/system/machine.F
36!|| startime ../engine/source/system/timer_mod.F90
37!|| stoptime ../engine/source/system/timer_mod.F90
38!|| sum_6_float_sens ../engine/source/system/parit.F
39!||--- uses -----------------------------------------------------
40!|| h3d_mod ../engine/share/modules/h3d_mod.F
41!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
42!|| message_mod ../engine/share/message_module/message_mod.F
43!|| timer_mod ../engine/source/system/timer_mod.f90
44!||====================================================================
45 SUBROUTINE i23mainf(TIMERS,
46 1 IPARI ,INTBUF_TAB ,X ,A ,
47 2 ICODT ,FSAV ,V ,MS ,ITAB ,
48 3 STIFN ,FSKYI ,ISKY ,FCONT ,NIN ,
49 4 LINDMAX ,JTASK ,NB_JLT ,NB_JLT_NEW,NB_STOK_N,
50 5 NSTRF ,SECFCUM ,ICONTACT ,VISCN ,NUM_IMP ,
51 6 NS_IMP ,NE_IMP ,IND_IMP ,NRTMDIM ,FNCONT ,
52 7 FTCONT ,RCONTACT ,ACONTACT ,PCONTACT,KINET ,
53 8 WEIGHT ,MSKYI_SMS,ISKYI_SMS,NODNX_SMS ,NODGLOB,
54 9 NPC ,TF , NISKYFI ,NEWFRONT ,MWAG ,
55 A FBSAV6 ,ISENSINT,DIMFB ,DT2T ,H3D_DATA)
56C-----------------------------------------------
57C M o d u l e s
58C-----------------------------------------------
59 USE timer_mod
60 USE intbufdef_mod
61 USE h3d_mod
62 USE message_mod
63C-----------------------------------------------
64C I m p l i c i t T y p e s
65C-----------------------------------------------
66#include "implicit_f.inc"
67#include "comlock.inc"
68C-----------------------------------------------
69C G l o b a l P a r a m e t e r s
70C-----------------------------------------------
71#include "mvsiz_p.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "com04_c.inc"
76#include "com08_c.inc"
77#include "impl1_c.inc"
78#include "param_c.inc"
79#include "parit_c.inc"
80#include "task_c.inc"
81#include "timeri_c.inc"
82#include "warn_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 TYPE(timer_), INTENT(inout) :: TIMERS
87 INTEGER NELTST, ITYPTST, NIN, NSTRF(*), NRTMDIM, NEWFRONT,
88 . NISKYFI
89 INTEGER IPARI(NPARI,NINTER), ICODT(*),ICONTACT(*),
90 . ITAB(*), ISKY(*), KINET(*), ISKYI_SMS(*), NODNX_SMS(*),
91 . TAGMSR_I21_SMS, NODGLOB(*), NPC(*), MWAG(*)
92 INTEGER NB_JLT,NB_JLT_NEW,NB_STOK_N,JTASK,
93 . LINDMAX,DIMFB
94 INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),IND_IMP(*), WEIGHT(*)
95C REAL
96 my_real
97 . x(*), a(3,*), fsav(*), v(3,*),
98 . ms(*),stifn(*),fskyi(lskyi,4), fcont(3,*),
99 . secfcum(7,numnod,nsect), viscn(*),
100 . fncont(3,*), ftcont(3,*), rcontact(*), acontact(*),
101 . pcontact(*), mskyi_sms(*),
102 . tf(*), dt2t
103 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
104
105 TYPE(intbuf_struct_) INTBUF_TAB
106 TYPE(h3d_database) :: H3D_DATA
107C-----------------------------------------------
108C L o c a l V a r i a b l e s
109C-----------------------------------------------
110 INTEGER I, I_STOK, JLT_NEW, JLT , NFT, J,
111 . IBC, NOINT, NSEG, ISECIN, IBAG,
112 . IGAP, INACTI, IFQ, MFROT, IGSTI, NISUB,
113 . nb_loc, i_stok_loc,debut,
114 . intth,iform, ncand, ikthe, ifstf, h, ierror
115 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
116 . nsvg(mvsiz), cn_loc(mvsiz),ce_loc(mvsiz),
117 . cand_n_n(mvsiz), cand_e_n(mvsiz), kini(mvsiz),
118 . index2(lindmax),
119 . nsms(mvsiz), isensint(*)
120C REAL
121 my_real
122 . startt, fric, gap, stopt,
123 . visc,stiglo,gapmin,
124 . kmin, kmax, gapmax, kthe, xthe, tint, rhoh,
125 . scal_t, deri
126C-----------------------------------------------
127C E x t e r n a l F u n c t i o n s
128C-----------------------------------------------
129 my_real
130 . finter
131C-----------------------------------------------
132C REAL
133 my_real
134 . lb(mvsiz), lc(mvsiz),
135 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
136 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
137 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
138 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
139 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
140 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
141 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
142 . nx(mvsiz), ny(mvsiz), nz(mvsiz), pene(mvsiz),
143 . gapv(mvsiz),vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz),
144 . mxi(mvsiz), myi(mvsiz), mzi(mvsiz), stri(mvsiz),
145 . penrad(mvsiz), fxt(mvsiz), fyt(mvsiz), fzt(mvsiz)
146 my_real
147 . vxm(mvsiz), vym(mvsiz), vzm(mvsiz),
148 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
149 . fx, fy, fz, stf
150 INTEGER ICURV, IP0, IP1, IP2, IS, SFSAVPARIT
151 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGP
152 my_real, DIMENSION(:,:,:), ALLOCATABLE :: FSAVPARIT
153 INTEGER :: NSN
154 INTEGER :: NMN
155 INTEGER :: NTY
156
157C----------------------------------------------------
158C
159 nsn =ipari(5,nin)
160 nmn =ipari(6,nin)
161 nty =ipari(7,nin)
162 ibc =ipari(11,nin)
163 IF(ipari(33,nin)==1) RETURN
164 noint =ipari(15,nin)
165 igap =ipari(21,nin)
166 inacti=ipari(22,nin)
167 isecin=ipari(28,nin)
168 mfrot =ipari(30,nin)
169 ifq =ipari(31,nin)
170 ibag =ipari(32,nin)
171 igsti=ipari(34,nin)
172 nisub =ipari(36,nin)
173 icurv =ipari(39,nin)
174 ifstf =ipari(48,nin)
175C no heat interface
176 intth = ipari(47,nin)
177 scal_t= intbuf_tab%VARIABLES(33)
178C
179 stiglo=-intbuf_tab%STFAC(1)
180 IF(ifstf/=0)stiglo = stiglo*finter(ifstf,tt/scal_t,npc,tf,deri)
181C
182 startt=intbuf_tab%VARIABLES(3)
183 stopt =intbuf_tab%VARIABLES(11)
184 IF(startt>tt) RETURN
185 IF(tt>stopt) RETURN
186C
187 fric =intbuf_tab%VARIABLES(1)
188 gap =intbuf_tab%VARIABLES(2)
189 gapmin=intbuf_tab%VARIABLES(13)
190 visc =intbuf_tab%VARIABLES(14)
191C
192 gapmax=intbuf_tab%VARIABLES(16)
193 kmin =intbuf_tab%VARIABLES(17)
194 kmax =intbuf_tab%VARIABLES(18)
195C
196C -------------------------------------------------------------
197C STOCKAGE DES ANCIENS CANDIDATS
198C -------------------------------------------------------------
199C
200C Barriere dans tous les cas pour bminma [et cur_max_max]
201C
202 CALL my_barrier
203C
204 i_stok = intbuf_tab%I_STOK(1)
205cC
206c ALLOCATE(ITAGP(NMN))
207c ITAGP(1:NMN)=0
208cC
209c IP0 = 1
210c IP1 = IP0 + NSN + 3
211cC IP1 = IP0 + NSN + NSNROLD + 3
212c IP2 = IP1 + I_STOK
213c IF(JTASK==1)THEN
214cC MWA = MWAG SUR TASK 0
215c CALL I23TRCF(
216cC 1 NSN+NSNROLD ,I_STOK ,INBUF(KD(15)),INBUF(KD(14)),
217c 1 NSN ,I_STOK ,INBUF(KD(15)),INBUF(KD(14)),
218c 3 MWAG(IP0) ,MWAG(IP1) ,INBUF(KD(27)))
219c ENDIF
220cC
221c IF(JTASK==1)THEN
222c ALLOCATE(IFPEN_SAV(I_STOK),CAND_P_SAV(I_STOK))
223c IFPEN_SAV(1:I_STOK) =INBUF(KD(27):KD(27)+I_STOK-1)
224c CAND_P_SAV(1:I_STOK)=BUFIN(JD(18):JD(18)+I_STOK-1)
225c END IF
226C
227C----------------------------------------------------
228C
229 CALL my_barrier
230C
231C----------------------------------------------------
232C decoupage statique
233 nb_loc = i_stok / nthread
234 IF (jtask==nthread) THEN
235 i_stok_loc = i_stok-nb_loc*(nthread-1)
236 ELSE
237 i_stok_loc = nb_loc
238 ENDIF
239 debut = (jtask-1)*nb_loc
240C
241 i_stok = 0
242C
243 IF (impl_s==1) THEN
244 num_imp = 0
245 visc =zero
246 ENDIF
247C
248 DO i = debut+1, debut+i_stok_loc
249 IF(intbuf_tab%CAND_N(i)<0) THEN
250 i_stok = i_stok + 1
251 index2(i_stok) = i
252C inbuf == cand_n
253 intbuf_tab%CAND_N(i) = -intbuf_tab%CAND_N(i)
254 ELSE
255 intbuf_tab%CAND_P(i) = zero
256 intbuf_tab%FTSAVX(i) = zero
257 intbuf_tab%FTSAVY(i) = zero
258 intbuf_tab%FTSAVZ(i) = zero
259 intbuf_tab%IFPEN(i) = 0
260 ENDIF
261 ENDDO
262C
263c------------------------------------------------
264 IF (debug(3)>=1) THEN
265 nb_jlt = nb_jlt + i_stok_loc
266 nb_stok_n = nb_stok_n + i_stok
267 ENDIF
268C
269 sfsavparit = 0
270 DO i=1,nisub+1
271 IF(isensint(i)/=0) THEN
272 sfsavparit = sfsavparit + 1
273 ENDIF
274 ENDDO
275 IF (sfsavparit /= 0) THEN
276 ALLOCATE(fsavparit(nisub+1,11,i_stok),stat=ierror)
277 IF(ierror/=0) THEN
278 CALL ancmsg(msgid=19,anmode=aninfo,
279 . c1='(/INTER/TYPE23)')
280 CALL arret(2)
281 ENDIF
282 DO j=1,i_stok
283 DO i=1,11
284 DO h=1,nisub+1
285 fsavparit(h,i,j) = zero
286 ENDDO
287 ENDDO
288 ENDDO
289 ELSE
290 ALLOCATE(fsavparit(0,0,0),stat=ierror)
291 IF(ierror/=0) THEN
292 CALL ancmsg(msgid=19,anmode=aninfo,
293 . c1='(/INTER/TYPE23)')
294 CALL arret(2)
295 ENDIF
296 ENDIF
297c
298 DO nft = 0 , i_stok - 1 , nvsiz
299 jlt = min( nvsiz, i_stok - nft )
300C preparation candidats retenus
301 CALL i7cdcor3(
302 1 jlt,index2(nft+1),intbuf_tab%CAND_E,intbuf_tab%CAND_N,
303 2 cand_e_n,cand_n_n)
304C cand_n et cand_e remplace par cand_n_n et cand_e_n
305 CALL i23cor3(
306 1 jlt ,nin ,x ,intbuf_tab%IRECTM,nsn ,
307 2 intbuf_tab%NSV,cand_e_n ,cand_n_n ,intbuf_tab%STFM,
308 + intbuf_tab%STFNS,
309 3 intbuf_tab%MSR,ms ,v ,xi ,yi ,
310 4 zi ,ix1 ,ix2 ,ix3 ,ix4 ,
311 5 nsvg ,igsti ,stif ,kmin ,kmax ,
312 6 igap ,gap ,intbuf_tab%GAP_S,gapv ,gapmax ,
313 7 gapmin ,intbuf_tab%GAP_M,vxi ,vyi ,vzi,
314 8 msi ,nodnx_sms,nsms ,kinet ,x1 ,
315 9 y1 ,z1 ,x2 ,y2 ,z2 ,
316 a x3 ,y3 ,z3 ,x4 ,y4 ,
317 b z4 ,nx1 ,nx2 ,nx3 ,nx4 ,
318 c ny1 ,ny2 ,ny3 ,ny4 ,nz1 ,
319 d nz2 ,nz3 ,nz4 ,kini ,index2(nft+1))
320C
321 jlt_new = 0
322C
323 CALL i23dst3(
324 1 jlt ,cand_n_n ,cand_e_n ,cn_loc ,ce_loc ,
325 2 x1 ,x2 ,x3 ,x4 ,y1 ,
326 3 y2 ,y3 ,y4 ,z1 ,z2 ,
327 4 z3 ,z4 ,xi ,yi ,zi ,
328 6 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
329 7 gapv ,inacti ,index2(nft+1),
330 8 vxm ,vym ,vzm ,h1 ,h2 ,
331 9 h3 ,h4 ,intbuf_tab%IRECTM,intbuf_tab%CAND_P,
332 a intbuf_tab%IFPEN,nx ,ny ,nz ,intbuf_tab%FTSAVX,
333 b intbuf_tab%FTSAVY,intbuf_tab%FTSAVZ,fxt ,fyt ,fzt,
334 c pene ,v ,vxi ,vyi ,vzi ,
335 d msi ,stif ,jlt_new,nsms ,kini )
336 jlt = jlt_new
337 IF (imonm > 0) CALL startime(timers,20)
338
339 IF(jlt_new/=0) THEN
340 ipari(29,nin) = 1
341 IF (debug(3)>=1)
342 . nb_jlt_new = nb_jlt_new + jlt
343C
344 CALL i23for3(
345 1 jlt ,nin ,noint ,ibc ,icodt ,
346 2 fsav ,gap ,stiglo ,fric ,visc ,
347 3 inacti ,mfrot ,ifq ,ibag ,
348 4 ipari(39,nin),stif ,gapv ,itab ,a ,
349 5 intbuf_tab%CAND_P,intbuf_tab%FRIC_P,intbuf_tab%XFILTR,v ,icontact,
350 6 niskyfi ,nsvg ,x1 ,y1 ,z1 ,
351 7 x2 ,y2 ,z2 ,x3 ,y3 ,
352 8 z3 ,x4 ,y4 ,z4 ,xi ,
353 9 yi ,zi ,vxi ,vyi ,vzi ,
354 a msi ,vxm ,vym ,vzm ,nx ,
355 b ny ,nz ,pene ,h1 ,h2 ,
356 c h3 ,h4 ,index2(nft+1),cand_n_n ,weight ,
357 f fxt ,fyt ,fzt ,dt2t ,
358 g fcont ,fncont ,ftcont ,stifn ,viscn ,
359 h newfront ,isecin ,nstrf ,secfcum ,fskyi ,
360 i isky ,intth ,ms ,ix1 ,ix2 ,
361 j ix3 ,ix4 ,intbuf_tab%FTSAVX,intbuf_tab%FTSAVY,intbuf_tab%FTSAVZ,
362 k kmin ,kmax ,cn_loc ,ce_loc ,mskyi_sms ,
363 l iskyi_sms ,nsms ,jtask ,isensint ,fsavparit ,
364 m nisub ,nft ,h3d_data )
365C
366 ENDIF ! JLT_NEW/=0
367 IF (imonm > 0) CALL stoptime(timers,20)
368C
369 ENDDO
370c
371 IF (sfsavparit /= 0)THEN
372 CALL sum_6_float_sens(fsavparit, nisub+1, 11, i_stok,1,i_stok,
373 . fbsav6, 12, 6, dimfb, isensint )
374 ENDIF
375 IF(ALLOCATED(fsavparit)) DEALLOCATE (fsavparit)
376C
377 CALL my_barrier
378C
379c DEALLOCATE(ITAGP)
380c IF(JTASK==1)DEALLOCATE(IFPEN_SAV,CAND_P_SAV)
381 RETURN
382 END
my_real
#define my_real
Definition cppsort.cpp:32
i23cor3
subroutine i23cor3(jlt, nin, x, irect, nsn, nsv, cand_e, cand_n, stf, stfn, msr, ms, v, xi, yi, zi, ix1, ix2, ix3, ix4, nsvg, igsti, stif, kmin, kmax, igap, gap, gap_s, gapv, gapmax, gapmin, gap_m, vxi, vyi, vzi, msi, nodnx_sms, nsms, kinet, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, kini, index)
Definition i23cor3.F:43
i23for3
subroutine i23for3(jlt, nin, noint, ibc, icodt, fsav, gap, stiglo, fric, visc, inacti, mfrot, ifq, ibag, icurv, stif, gapv, itab, a, cand_p, frot_p, alpha0, v, icontact, niskyfi, nsvg, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, xi, yi, zi, vxi, vyi, vzi, msi, vxm, vym, vzm, nx, ny, nz, pene, h1, h2, h3, h4, index, cand_n_n, weight, fxt, fyt, fzt, dt2t, fcont, fncont, ftcont, stifn, viscn, newfront, isecin, nstrf, secfcum, fskyi, isky, intth, ms, ix1, ix2, ix3, ix4, cand_fx, cand_fy, cand_fz, kmin, kmax, cn_loc, ce_loc, mskyi_sms, iskyi_sms, nsms, jtask, isensint, fsavparit, nisub, nft, h3d_data)
Definition i23for3.F:61
i23mainf
subroutine i23mainf(timers, ipari, intbuf_tab, x, a, icodt, fsav, v, ms, itab, stifn, fskyi, isky, fcont, nin, lindmax, jtask, nb_jlt, nb_jlt_new, nb_stok_n, nstrf, secfcum, icontact, viscn, num_imp, ns_imp, ne_imp, ind_imp, nrtmdim, fncont, ftcont, rcontact, acontact, pcontact, kinet, weight, mskyi_sms, iskyi_sms, nodnx_sms, nodglob, npc, tf, niskyfi, newfront, mwag, fbsav6, isensint, dimfb, dt2t, h3d_data)
Definition i23mainf.F:56
i7cdcor3
subroutine i7cdcor3(jlt, index, cand_e, cand_n, cand_e_n, cand_n_n)
Definition i7cdcor3.F:38
min
#define min(a, b)
Definition macros.h:20
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
sum_6_float_sens
subroutine sum_6_float_sens(f, a, b, c, jft, jlt, f6, d, e, g, isensint)
Definition parit.F:540
i23dst3
subroutine i23dst3(jlt, cand_n, cand_e, irect, nsv, gap_s, x, msr, pene, ifpen, igap, gap, gapmax, gapmin, gapv, gap_m)
Definition i23dst3.F:33
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
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
stri
character *8 function stri(n)
Definition stri.F:24
h3d_mod::h3d_database
Definition h3d_mod.F:435