OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i10mainf.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "warn_c.inc"
#include "parit_c.inc"
#include "task_c.inc"
#include "impl1_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i10mainf (output, ipari, x, a, icodt, fsav, v, ms, dt2t, neltst, ityptst, itab, stifn, fskyi, isky, fcont, lindmax, jtask, nb_jlt, nb_jlt_new, nb_stok_n, niskyfi, nstrf, secfcum, viscn, nin, fsavsub, num_imp, ns_imp, ne_imp, ind_imp, fncont, ftcont, mskyi_sms, iskyi_sms, nodnx_sms, icontact, intbuf_tab, fbsav6, isensint, dimfb, h3d_data, nodadt_therm)

Function/Subroutine Documentation

◆ i10mainf()

subroutine i10mainf ( type(output_), intent(inout) output,
integer, dimension(*) ipari,
x,
a,
integer, dimension(*) icodt,
fsav,
v,
ms,
dt2t,
integer neltst,
integer ityptst,
integer, dimension(*) itab,
stifn,
fskyi,
integer, dimension(*) isky,
fcont,
integer lindmax,
integer jtask,
integer nb_jlt,
integer nb_jlt_new,
integer nb_stok_n,
integer niskyfi,
integer, dimension(*) nstrf,
secfcum,
viscn,
integer nin,
fsavsub,
integer num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) ind_imp,
fncont,
ftcont,
mskyi_sms,
integer, dimension(*) iskyi_sms,
integer, dimension(*) nodnx_sms,
integer, dimension(*) icontact,
type(intbuf_struct_) intbuf_tab,
double precision, dimension(12,6,dimfb) fbsav6,
integer, dimension(*) isensint,
integer dimfb,
type(h3d_database) h3d_data,
integer, intent(in) nodadt_therm )

Definition at line 41 of file i10mainf.F.

51C============================================================================
52C this routine is called by : INTFOP2(/interf/intfop2.F)
53C----------------------------------------------------------------------------
54C cette routine appelle : I7CDCOR3(int7/i7cdcor3.F)
55C I7COR3(int7/i7cor3.F)
56C I10DST3(int10/i10dst3.F)
57C I10FOR3(int10/i10for3.F)
58C============================================================================
59C-----------------------------------------------
60C M o d u l e s
61C-----------------------------------------------
62 use output_mod
63 USE intbufdef_mod
64 USE h3d_mod
65 USE message_mod
66C-----------------------------------------------
67C I m p l i c i t T y p e s
68C-----------------------------------------------
69#include "implicit_f.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 "param_c.inc"
80#include "warn_c.inc"
81#include "parit_c.inc"
82#include "task_c.inc"
83#include "impl1_c.inc"
84C-----------------------------------------------
85C D u m m y A r g u m e n t s
86C-----------------------------------------------
87 type(output_), intent(inout) :: output
88 INTEGER NELTST,ITYPTST,NSTRF(*),
89 . NISKYFI,NIN,LINDMAX
90 INTEGER IPARI(*), ICODT(*), ITAB(*),
91 . ISKY(*), ISKYI_SMS(*), NODNX_SMS(*),
92 . ICONTACT(*), ISENSINT(*),DIMFB
93 INTEGER ,INTENT(IN) :: NODADT_THERM
94C Interface Statistics
95 INTEGER NB_JLT,NB_JLT_NEW,NB_STOK_N,JTASK
96 INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),IND_IMP(*)
97C REAL
98 my_real dt2t,
99 . x(*), a(3,*), fsav(*), v(3,*),
100 . ms(*),stifn(*),fskyi(lskyi,4),fcont(*),
101 . secfcum(7,numnod,nsect),
102 . viscn(*), fsavsub(*), fncont(3,*), ftcont(3,*),
103 . mskyi_sms(*)
104
105 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
106
107 TYPE(INTBUF_STRUCT_) INTBUF_TAB
108 TYPE(H3D_DATABASE) :: H3D_DATA
109C-----------------------------------------------
110C L o c a l V a r i a b l e s
111C-----------------------------------------------
112 INTEGER IDUM,
113 . I, J, H, NOINT, ISECIN, I_STOK,
114 . IGAP, JLT_NEW, JLT , NFT, ITIED, IGSTI, NISUB, IADM,
115 . NB_LOC,I_STOK_LOC,DEBUT, IERROR
116 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
117 . NSVG(MVSIZ), CAND_N_N(MVSIZ),CAND_E_N(MVSIZ),
118 . CN_LOC(MVSIZ),CE_LOC(MVSIZ),
119 . INDEX2(LINDMAX),IBID,SFSAVPARIT
120 INTEGER NSMS(MVSIZ)
121C REAL
122 my_real
123 . startt, gap, stopt,
124 . visc, stiglo, gapmin, kmin, kmax, gapmax,
125 . rbid
126C-----------------------------------------------
127C REAL
128 my_real
129 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
130 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
131 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
132 . lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
133 . lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
134 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(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 .
140 .
141 . gapv(mvsiz),
142 . vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz)
143
144 my_real, DIMENSION(:,:,:), ALLOCATABLE :: fsavparit
145 INTEGER :: NTY,NSN
146C
147 idum = 0
148 nsn =ipari(5)
149 nty =ipari(7)
150 noint =ipari(15)
151 igap =ipari(21)
152 isecin=ipari(28)
153 igsti =ipari(34)
154 nisub =ipari(36)
155C
156 stiglo=-intbuf_tab%STFAC(1)
157 startt=intbuf_tab%VARIABLES(3)
158 stopt =intbuf_tab%VARIABLES(11)
159 IF(startt>tt) RETURN
160 IF(tt>stopt) RETURN
161C
162 itied =nint(intbuf_tab%VARIABLES(1))
163 gap =intbuf_tab%VARIABLES(2)
164 gapmin=intbuf_tab%VARIABLES(13)
165 visc =intbuf_tab%VARIABLES(14)
166 gapmax=intbuf_tab%VARIABLES(16)
167 kmin =intbuf_tab%VARIABLES(17)
168 kmax =intbuf_tab%VARIABLES(18)
169 iadm=ipari(44)
170C
171 rbid = zero
172 ibid = 0
173 IF(nty==10)THEN
174C
175 i_stok = intbuf_tab%I_STOK(1)
176 IF (impl_s==1) THEN
177 num_imp = 0
178 visc =zero
179 ENDIF
180C this part is executed in // after the calculation of the forces of the elements.
181C static decoupage
182 nb_loc = i_stok / nthread
183 IF (jtask==nthread) THEN
184 i_stok_loc = i_stok-nb_loc*(nthread-1)
185 ELSE
186 i_stok_loc = nb_loc
187 ENDIF
188 debut = (jtask-1)*nb_loc
189 i_stok = 0
190C recalculation of istok
191 DO i = debut+1, debut+i_stok_loc
192 IF(intbuf_tab%CAND_N(i)<0) THEN
193 i_stok = i_stok + 1
194 index2(i_stok) = i
195C inbuf == cand_n
196 intbuf_tab%CAND_N(i) = -intbuf_tab%CAND_N(i)
197 ELSEIF(itied/=0.AND.intbuf_tab%CAND_F(6*(i-1)+1)/=0.) THEN
198 i_stok = i_stok + 1
199 index2(i_stok) = i
200 ELSE
201C reset of cand_f of 1, 2, 3
202 intbuf_tab%CAND_F(6*(i-1)+1) = zero
203 intbuf_tab%CAND_F(6*(i-1)+2) = zero
204 intbuf_tab%CAND_F(6*(i-1)+3) = zero
205 ENDIF
206 ENDDO
207 IF (debug(3)>=1) THEN
208 nb_jlt = nb_jlt + i_stok_loc
209 nb_stok_n = nb_stok_n + i_stok
210 ENDIF
211C
212 sfsavparit = 0
213 DO i=1,nisub+1
214 IF(isensint(i)/=0) THEN
215 sfsavparit = sfsavparit + 1
216 ENDIF
217 ENDDO
218 IF (sfsavparit /= 0) THEN
219 ALLOCATE(fsavparit(nisub+1,11,i_stok),stat=ierror)
220 IF(ierror/=0) THEN
221 CALL ancmsg(msgid=19,anmode=aninfo,
222 . c1='(/INTER/TYPE10)')
223 CALL arret(2)
224 ENDIF
225 DO j=1,i_stok
226 DO i=1,11
227 DO h=1,nisub+1
228 fsavparit(h,i,j) = zero
229 ENDDO
230 ENDDO
231 ENDDO
232 ELSE
233 ALLOCATE(fsavparit(0,0,0),stat=ierror)
234 IF(ierror/=0) THEN
235 CALL ancmsg(msgid=19,anmode=aninfo,
236 . c1='(/inter/type10)')
237 CALL ARRET(2)
238 ENDIF
239 ENDIF
240c
241 DO NFT = 0 , I_STOK - 1 , NVSIZ
242 JLT = MIN( NVSIZ, I_STOK - NFT )
243C preparation CANDIDATES retenus
244 CALL I7CDCOR3(
245 1 JLT,INDEX2(NFT+1),INTBUF_TAB%CAND_E,INTBUF_TAB%CAND_N,CAND_E_N,
246 2 CAND_N_N)
247 CALL I7COR3(
248 1 JLT ,X ,INTBUF_TAB%IRECTM,INTBUF_TAB%NSV,CAND_E_N,
249 2 CAND_N_N ,INTBUF_TAB%STFM,INTBUF_TAB%STFNS,X1 ,X2 ,
250 3 X3 ,X4 ,Y1 ,Y2 ,Y3 ,
251 4 Y4 ,Z1 ,Z2 ,Z3 ,Z4 ,
252 5 XI ,YI ,ZI ,STIF ,IX1 ,
253 6 IX2 ,IX3 ,IX4 ,NSVG ,IGAP ,
254 7 GAP ,INTBUF_TAB%GAP_S,INTBUF_TAB%GAP_M,GAPV,
255 9 MS ,VXI ,VYI ,
256 A VZI ,MSI ,NSN ,V ,IDUM ,
257 B IDUM ,NTY ,NIN ,IGSTI ,KMIN ,
258 C KMAX ,GAPMAX ,GAPMIN ,IADM ,RBID ,
259 D RBID ,RBID ,RBID ,IBID ,RBID ,
260 E RBID ,RBID ,RBID ,IBID ,RBID ,
261 F IBID ,NODNX_SMS ,NSMS ,RBID ,RBID ,
262 G IBID ,IBID ,IBID ,IBID ,IBID ,
263 H IBID ,IBID ,RBID ,IBID ,RBID )
264 JLT_NEW = 0
265 CALL I10DST3(
266 1 JLT ,CAND_N_N,CAND_E_N,CN_LOC,CE_LOC ,
267 2 X1 ,X2 ,X3 ,X4 ,Y1 ,
268 3 Y2 ,Y3 ,Y4 ,Z1 ,Z2 ,
269 4 Z3 ,Z4 ,XI ,YI ,ZI ,
270 5 NX1 ,NX2 ,NX3 ,NX4 ,NY1 ,
271 6 NY2 ,NY3 ,NY4 ,NZ1 ,NZ2 ,
272 7 NZ3 ,NZ4 ,LB1 ,LB2 ,LB3 ,
273 8 LB4 ,LC1 ,LC2 ,LC3 ,LC4 ,
274 9 P1 ,P2 ,P3 ,P4 ,IX1 ,
275 A IX2 ,IX3 ,IX4 ,NSVG ,STIF ,
276 B JLT_NEW,GAPV,INTBUF_TAB%CAND_F,INDEX2(NFT+1),ITIED,
277 C VXI ,VYI ,VZI ,MSI ,NSMS )
278 JLT = JLT_NEW
279 IF(JLT_NEW/=0) THEN
280 IPARI(29) = 1
281 IF (DEBUG(3)>=1)
282 . NB_JLT_NEW = NB_JLT_NEW + JLT_NEW
283C WRITE(6,*) 'IMPACT ==> CALL I10FOR3'
284 CALL I10FOR3(output,
285 1 JLT ,A ,MS ,V ,FSAV ,
286 2 INTBUF_TAB%CAND_F,STIFN,STIF ,FSKYI ,ISKY ,
287 3 ITIED ,VISC ,X1 ,X2 ,X3 ,
288 4 X4 ,Y1 ,Y2 ,Y3 ,Y4 ,
289 5 Z1 ,Z2 ,Z3 ,Z4 ,NSVG ,
290 6 NX1 ,NX2 ,NX3 ,NX4 ,NY1 ,
291 7 NY2 ,NY3 ,NY4 ,NZ1 ,NZ2 ,
292 8 NZ3 ,NZ4 ,LB1 ,LB2 ,LB3 ,
293 9 LB4 ,LC1 ,LC2 ,LC3 ,LC4 ,
294 A P1 ,P2 ,P3 ,P4 ,FCONT ,
295 B IX1 ,IX2 ,IX3 ,IX4 ,GAPV ,
296 C INDEX2(NFT+1),NISKYFI ,ISECIN ,NSTRF ,SECFCUM ,
297 D NOINT ,VISCN ,VXI ,VYI ,VZI ,
298 E MSI ,NIN ,NISUB ,INTBUF_TAB%LISUB,INTBUF_TAB%ADDSUBS,
299 F INTBUF_TAB%ADDSUBM,INTBUF_TAB%LISUBS,INTBUF_TAB%LISUBM,CN_LOC,CE_LOC,
300 G FSAVSUB ,FNCONT ,FTCONT ,MSKYI_SMS ,ISKYI_SMS ,
301 H NSMS ,XI ,YI ,ZI ,ICONTACT,
302 I DT2T ,NELTST ,ITYPTST ,JTASK ,ISENSINT,
303 J FSAVPARIT ,NFT ,H3D_DATA,NODADT_THERM)
304 ENDIF
305 IF(IMPL_S==1) THEN
306 DO I = 1 ,JLT_NEW
307 NS_IMP(I+NUM_IMP)=CN_LOC(I)
308 NE_IMP(I+NUM_IMP)=CE_LOC(I)
309 IND_IMP(I+NUM_IMP)=INDEX2(I+NFT)
310 ENDDO
311 NUM_IMP=NUM_IMP+JLT_NEW
312 ENDIF
313 ENDDO
314c
315 IF (SFSAVPARIT /= 0)THEN
316 CALL SUM_6_FLOAT_SENS(FSAVPARIT, NISUB+1, 11, I_STOK,1,I_STOK,
317 . FBSAV6, 12, 6, DIMFB, ISENSINT )
318 ENDIF
319 IF (ALLOCATED(FSAVPARIT)) DEALLOCATE (FSAVPARIT)
320C
321 ENDIF
322C
323 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
h3d_mod
Definition h3d_mod.F:311
message_mod
Definition message_mod.F:1257
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