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