OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25mainf.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "assert.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "warn_c.inc"
#include "task_c.inc"
#include "parit_c.inc"
#include "timeri_c.inc"
#include "macro.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i25mainf (output, timers, ipari, intbuf_tab, x, a, icodt, fsav, v, ms, dt2t, neltst, ityptst, itab, stifn, fskyi, isky, fcont, nin, lindmax, kinet, jtask, nb_impct, niskyfi, newfront, nstrf, secfcum, icontact, viscn, num_imp, ns_imp, ne_imp, ind_imp, fsavsub, nrtmdim, fsavbag, eminx, ixs, ixs16, ixs20, fncont, ftcont, iad_elem, fr_elem, rcontact, acontact, pcontact, temp, fthe, ftheskyi, pm, iparg, iad17, mskyi_sms, iskyi_sms, nodnx_sms, ms0, inod_pxfem, ms_ply, wagap, fbsav6, isensint, nodadt_therm, theaccfact, dimfb, h3d_data, intbuf_fric_tab, niskyfie, apinch, stifpinch, npc, tf, condn, condnskyi, qfricint, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, dgaploadint, s_loadpinter, interefric, interfaces)
subroutine i25cdcor3 (jlt, index, cand_e, cand_n, cand_e_n, cand_n_n)
subroutine i25cdcor3_e2s (jlt, index, cand_e, cand_n, cand_e_n, cand_n_n)

Function/Subroutine Documentation

◆ i25cdcor3()

subroutine i25cdcor3 ( integer jlt,
integer, dimension(*) index,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e_n,
integer, dimension(*) cand_n_n )

Definition at line 1168 of file i25mainf.F.

1170C============================================================================
1171C-----------------------------------------------
1172C D u m m y A r g u m e n t s
1173C-----------------------------------------------
1174 INTEGER JLT,
1175 . INDEX(*), CAND_E(*), CAND_N(*),
1176 . CAND_E_N(*), CAND_N_N(*)
1177C-----------------------------------------------
1178C L o c a l V a r i a b l e s
1179C-----------------------------------------------
1180 INTEGER I
1181C-----------------------------------------------
1182C
1183 DO i=1,jlt
1184 cand_e_n(i) = cand_e(index(i))
1185 cand_n_n(i) = cand_n(index(i))
1186 ENDDO
1187C
1188 RETURN

◆ i25cdcor3_e2s()

subroutine i25cdcor3_e2s ( integer jlt,
integer, dimension(*) index,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e_n,
integer, dimension(*) cand_n_n )

Definition at line 1195 of file i25mainf.F.

1197C============================================================================
1198C-----------------------------------------------
1199C D u m m y A r g u m e n t s
1200C-----------------------------------------------
1201 INTEGER JLT,
1202 . INDEX(*), CAND_E(*), CAND_N(*),
1203 . CAND_E_N(*), CAND_N_N(*)
1204C-----------------------------------------------
1205C L o c a l V a r i a b l e s
1206C-----------------------------------------------
1207 INTEGER I
1208C-----------------------------------------------
1209C
1210 DO i=1,jlt
1211 cand_e_n(i) = cand_e(index(i))
1212 cand_n_n(i) = cand_n(index(i))
1213 ENDDO
1214C
1215 RETURN

◆ i25mainf()

subroutine i25mainf ( type(output_), intent(inout) output,
type(timer_) timers,
integer, dimension(npari,ninter) ipari,
type(intbuf_struct_) intbuf_tab,
x,
a,
integer, dimension(*) icodt,
fsav,
v,
ms,
dt2t,
integer neltst,
integer ityptst,
integer, dimension(*) itab,
stifn,
fskyi,
integer, dimension(*) isky,
fcont,
integer nin,
integer lindmax,
integer, dimension(*) kinet,
integer jtask,
integer nb_impct,
integer niskyfi,
integer newfront,
integer, dimension(*) nstrf,
secfcum,
integer, dimension(*) icontact,
viscn,
integer num_imp,
integer, dimension(*) ns_imp,
integer, dimension(*) ne_imp,
integer, dimension(*) ind_imp,
fsavsub,
integer nrtmdim,
fsavbag,
eminx,
integer, dimension(*) ixs,
integer, dimension(*) ixs16,
integer, dimension(*) ixs20,
fncont,
ftcont,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
rcontact,
acontact,
pcontact,
temp,
fthe,
ftheskyi,
pm,
integer, dimension(nparg,*) iparg,
integer iad17,
mskyi_sms,
integer, dimension(*) iskyi_sms,
integer, dimension(*) nodnx_sms,
ms0,
integer, dimension(*) inod_pxfem,
ms_ply,
wagap,
double precision, dimension(12,6,dimfb) fbsav6,
integer, dimension(*) isensint,
integer, intent(in) nodadt_therm,
intent(in) theaccfact,
integer dimfb,
type(h3d_database) h3d_data,
type(intbuf_fric_struct_), dimension(ninterfric), target intbuf_fric_tab,
integer niskyfie,
apinch,
stifpinch,
integer, dimension(*) npc,
tf,
condn,
condnskyi,
qfricint,
integer, dimension(nloadp_hyd_inter,numnod) tagncont,
integer, dimension(ninter+1), intent(in) kloadpinter,
integer, dimension(s_loadpinter), intent(in) loadpinter,
integer, dimension(nloadp_hyd), intent(in) loadp_hyd_inter,
dimension(s_loadpinter), intent(in) dgaploadint,
integer, intent(in) s_loadpinter,
integer, intent(in) interefric,
type (interfaces_), intent(in) interfaces )

Definition at line 63 of file i25mainf.F.

84C=======================================================================
85C-----------------------------------------------
86C M o d u l e s
87C-----------------------------------------------
88 USE output_mod
89 USE timer_mod
90 USE intbufdef_mod
91 USE tri7box
92 USE h3d_mod
93 USE intbuf_fric_mod
94 USE message_mod
95 USE tri25ebox
96 USE interfaces_mod
97C-----------------------------------------------
98C I m p l i c i t T y p e s
99C-----------------------------------------------
100#include "implicit_f.inc"
101#include "comlock.inc"
102C-----------------------------------------------
103C G l o b a l P a r a m e t e r s
104C-----------------------------------------------
105#include "mvsiz_p.inc"
106C-----------------------------------------------
107C C o m m o n B l o c k s
108C-----------------------------------------------
109#include "assert.inc"
110#include "com01_c.inc"
111#include "com04_c.inc"
112#include "com08_c.inc"
113#include "param_c.inc"
114#include "warn_c.inc"
115#include "task_c.inc"
116#include "parit_c.inc"
117#include "timeri_c.inc"
118#include "macro.inc"
119C-----------------------------------------------
120C D u m m y A r g u m e n t s
121C-----------------------------------------------
122 type(output_), intent(inout) :: output
123 TYPE(TIMER_) :: TIMERS
124 INTEGER NELTST,ITYPTST,NIN,NEWFRONT,
125 . NSTRF(*),
126 . NRTMDIM, IAD17, IPARSENS
127 INTEGER IPARI(NPARI,NINTER), ICODT(*),ICONTACT(*),
128 . ITAB(*), ISKY(*), KINET(*),
129 . IPARG(NPARG,*),INOD_PXFEM(*),TAGNCONT(NLOADP_HYD_INTER,NUMNOD)
130 INTEGER NB_IMPCT,JTASK,
131 . NISKYFI, LINDMAX, NISKYFIE
132 INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),IND_IMP(*)
133 INTEGER IXS(*) ,IXS16(*) ,IXS20(*)
134 INTEGER IAD_ELEM(2,*),FR_ELEM(*), NPC(*),
135 . ISKYI_SMS(*), NODNX_SMS(*), ISENSINT(*),DIMFB
136 INTEGER , INTENT(IN) :: S_LOADPINTER
137 INTEGER , INTENT(IN) :: KLOADPINTER(NINTER+1),LOADPINTER(S_LOADPINTER),
138 . LOADP_HYD_INTER(NLOADP_HYD)
139 INTEGER , INTENT(IN) :: NODADT_THERM
140 INTEGER , INTENT(IN) :: INTEREFRIC
141 my_real , INTENT(IN) :: theaccfact
142 my_real , INTENT(IN) :: dgaploadint(s_loadpinter)
143 my_real
144 . eminx(*)
145C REAL
146 my_real dt2t,
147 . x(*), a(3,*), fsav(*), v(3,*),fsavbag(*),
148 . ms(*),stifn(*),fskyi(lskyi,4),fcont(3,*),ms0(*),
149 . secfcum(7,numnod,nsect),viscn(*), fsavsub(*),
150 . fncont(3,*), ftcont(3,*), rcontact(*), acontact(*),
151 . pcontact(*),
152 . temp(*),fthe(*),ftheskyi(lskyi),pm(npropm,*),
153 . mskyi_sms(*),ms_ply(*),wagap(*),
154 . apinch(3,*),stifpinch(*),qfricint(*),tf(*),condn(*),
155 . condnskyi(lskyi)
156 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
157 TYPE(INTBUF_STRUCT_) INTBUF_TAB
158 TYPE(H3D_DATABASE) :: H3D_DATA
159 TYPE(INTBUF_FRIC_STRUCT_), TARGET, DIMENSION(NINTERFRIC) :: INTBUF_FRIC_TAB
160 TYPE (INTERFACES_) ,INTENT(IN):: INTERFACES
161C-----------------------------------------------
162C L o c a l V a r i a b l e s
163C-----------------------------------------------
164 INTEGER JD(50),KD(50), JFI, KFI, IEDGE, ISHARP, NEDGE,
165 . I, J, L, H, I_STOK, JLT_NEW, JLT , NFT, IVIS2,
166 . IBC, NOINT, NSEG, ISECIN, IBAG, IADM,
167 . IGAP, INACTI, IFQ, MFROT, IGSTI, NISUB, IGAP0,
168 . NB_LOC, I_STOK_LOC,DEBUT,
169 . ILAGM, LENR, INTTH,IFORM,INTPLY,
170 . NADMSR, I_STOK_GLO, MGLOB, MG, N, NSNR, NN, IERROR,
171 . IE, I1, I2, IORTHFRIC ,NFORTH ,NFISOT ,JJ,FCOND,IKTHE,IFRIC,
172 . INTCAREA
173 INTEGER LENT, MAXCC
174 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
175 . NSVG(MVSIZ), CN_LOC(MVSIZ),CE_LOC(MVSIZ),
176 . CAND_N_N(MVSIZ),CAND_E_N(MVSIZ),
177 . KINI(MVSIZ),
178 . ISDSIZ(NSPMD+1),IRCSIZ(NSPMD+1),
179 . IELESI(MVSIZ), NSMS(MVSIZ), SUBTRIA(MVSIZ),
180 . NSNFT, NSNLT, NSNRFT, NSNRLT, INTFRIC,NSETPRTS ,NPARTFRIC,
181 . IPARTFRICSI(MVSIZ), IPARTFRICMI(MVSIZ), IFADHI(MVSIZ),
182 . MVOISN(MVSIZ,4),IBOUND(4,MVSIZ),INDEXISOT(MVSIZ),INDEXORTH(MVSIZ),
183 . IREP_FRICMI(MVSIZ),IPARTFRIC_ES(4*MVSIZ),IPARTFRIC_EM(4*MVSIZ),
184 . IELEMI(MVSIZ)
185 INTEGER :: EDGE_ID(2,4*MVSIZ)
186 INTEGER
187 . NE1(MVSIZ), NE2(MVSIZ), ME1(MVSIZ), ME2(MVSIZ),
188 . CS_LOC(MVSIZ), CM_LOC(MVSIZ),
189 . NS1(4*MVSIZ), NS2(4*MVSIZ), M1(4*MVSIZ), M2(4*MVSIZ), INDX1(4*MVSIZ), INDX2(4*MVSIZ),
190 . NSMSE(4*MVSIZ), CS_LOC4(4*MVSIZ), CM_LOC4(4*MVSIZ),
191 . TYPEDGS(MVSIZ),
192 . IAM(MVSIZ),JAM(MVSIZ),IBM(MVSIZ),JBM(MVSIZ),
193 . IAS(MVSIZ),JAS(MVSIZ),IBS(MVSIZ),JBS(MVSIZ)
194
195 INTEGER, ALLOCATABLE, DIMENSION(:) :: INDEX2
196C REAL
197 my_real
198 . startt, fric, gap, stopt, pmax_gap,
199 . visc,viscf,stiglo,gapmin,
200 . kmin, kmax, gapmax,kthe,tint,rhoh,eps,
201 . viscfluid, sigmaxadh, viscadhfact,
202 . fheats,fheatm,xthe,frad,drad,dcond
203C debug
204 integer :: eidm,eids
205C
206C-----------------------------------------------
207C REAL
208 my_real
209 . xx(mvsiz,5), yy(mvsiz,5), zz(mvsiz,5),
210 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
211 . nnx(mvsiz,5), nny(mvsiz,5), nnz(mvsiz,5),
212 . vx1(mvsiz), vx2(mvsiz), vx3(mvsiz), vx4(mvsiz),
213 . vy1(mvsiz), vy2(mvsiz), vy3(mvsiz), vy4(mvsiz),
214 . vz1(mvsiz), vz2(mvsiz), vz3(mvsiz), vz4(mvsiz),
215 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz),
216 . n1(mvsiz), n2(mvsiz), n3(mvsiz), pene(mvsiz),
217 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
218 . msi(mvsiz),
219 . nm1(mvsiz), nm2(mvsiz), nm3(mvsiz),
220 . tempi(mvsiz),phi(mvsiz),areasi(mvsiz),
221 . lb(mvsiz), lc(mvsiz),
222 . gap_nm(4,mvsiz), gaps(mvsiz), gapmxl(mvsiz),
223 . gapv(mvsiz), base_adh(mvsiz),
224 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
225 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
226 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
227 . fxi(mvsiz), fyi(mvsiz), fzi(mvsiz), fni(mvsiz),
228 . fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
229 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz),
230 . fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz),
231 . phi1(mvsiz), phi2(mvsiz),phi3(mvsiz),phi4(mvsiz) ,
232 . condint(mvsiz) ,efrict(mvsiz)
233 my_real
234 . gapve(4*mvsiz), stife(4*mvsiz), nx(4*mvsiz), ny(4*mvsiz), nz(4*mvsiz),
235 . hs1(4*mvsiz), hs2(4*mvsiz), hm1(4*mvsiz), hm2(4*mvsiz),
236 . xxs1(4*mvsiz), xxs2(4*mvsiz), xys1(4*mvsiz), xys2(4*mvsiz),
237 . xzs1(4*mvsiz), xzs2(4*mvsiz), xxm1(4*mvsiz), xxm2(4*mvsiz),
238 . xym1(4*mvsiz), xym2(4*mvsiz), xzm1(4*mvsiz), xzm2(4*mvsiz),
239 . vxs1(4*mvsiz), vxs2(4*mvsiz), vys1(4*mvsiz), vys2(4*mvsiz),
240 . vzs1(4*mvsiz), vzs2(4*mvsiz), vxm1(4*mvsiz), vxm2(4*mvsiz),
241 . vym1(4*mvsiz), vym2(4*mvsiz), vzm1(4*mvsiz), vzm2(4*mvsiz),
242 . ms1(4*mvsiz), ms2(4*mvsiz), mm1(4*mvsiz), mm2(4*mvsiz),
243 . ex(4*mvsiz), ey(4*mvsiz), ez(4*mvsiz), fx(mvsiz), fy(mvsiz),
244 . fz(mvsiz) , dist(mvsiz),
245 . normaln1(3,mvsiz) ,normaln2(3,mvsiz) ,normalm1(3,4,mvsiz),normalm2(3,4,mvsiz)
246
247 my_real
248 . , DIMENSION(:,:,:), ALLOCATABLE :: fsavparit
249 my_real
250 . rcurvi(mvsiz), anglmi(mvsiz), anglt, padm,penmin,marge
251 INTEGER NRTMFT, NRTMLT, NMNFT, NMNLT, NRADM, IS, IM, ISTIF_MSDT,IKNON(MVSIZ)
252 INTEGER ICURV,ILEV,NREBOU,NPT ,NRTSE,IEDG4,SFSAVPARIT,NCY_PFIT,NINLOADP
253 my_real
254 . xfiltr_fric,fric_coefs(mvsiz,10),viscffric(mvsiz),fricc(mvsiz),
255 . fric_coefs2(mvsiz,10),viscffric2(mvsiz),fricc2(mvsiz),
256 . dir1(mvsiz,3),dir2(mvsiz,3),dir_fricmi(mvsiz,2),fricc_e(4*mvsiz),
257 . viscffric_e(4*mvsiz),tncy,t_pfit,finc,dgaploadpmax,dtstif
258
259 INTEGER, DIMENSION(:) ,POINTER :: TABCOUPLEPARTS_FRIC
260 INTEGER, DIMENSION(:) ,POINTER :: TABPARTS_FRIC
261 INTEGER, DIMENSION(:) ,POINTER :: ADPARTS_FRIC
262 INTEGER, DIMENSION(:) ,POINTER :: IFRICORTH
263 my_real, DIMENSION(:) ,POINTER :: tabcoef_fric
264
265 INTEGER,TARGET, DIMENSION(1):: TABCOUPLEPARTS_FRIC_BID
266 INTEGER,TARGET, DIMENSION(1):: TABPARTS_FRIC_BID
267 INTEGER,TARGET, DIMENSION(1):: ADPARTS_FRIC_BID
268 INTEGER,TARGET, DIMENSION(1):: IFRICORTH_BID
269 my_real,TARGET, DIMENSION(1):: tabcoef_fric_bid
270
271 INTEGER :: NEDGE_REM,NRTM,NSN,NTY
272 LOGICAL :: SET_IPARI40_TO_ZERO
273C=======================================================================
274C
275 nrtm =ipari(4,nin)
276 nsn =ipari(5,nin)
277 nsnr =ipari(24,nin)
278 nty =ipari(7,nin)
279 ibc =ipari(11,nin)
280 ivis2 =ipari(14,nin)
281 IF(ipari(33,nin)==1) RETURN
282 noint =ipari(15,nin)
283 igap =ipari(21,nin)
284 inacti=ipari(22,nin)
285 isecin=ipari(28,nin)
286 mfrot =ipari(30,nin)
287 ifq =ipari(31,nin)
288 ibag =ipari(32,nin)
289 igsti=ipari(34,nin)
290 nisub =ipari(36,nin)
291 icurv =ipari(39,nin)
292 igap0 =ipari(53,nin)
293 iedge =ipari(58,nin)
294 nadmsr=ipari(67,nin)
295 isharp=ipari(84,nin)
296 nedge =ipari(68,nin)
297 nedge_rem = ipari(69,nin)
298C WRITE(6,*) "NEDGE REMOTE=", IPARI(69,NIN)
299C adaptive meshing
300 iadm =ipari(44,nin)
301 nradm=ipari(49,nin)
302 padm =intbuf_tab%VARIABLES(24)
303 anglt=intbuf_tab%VARIABLES(25)
304 marge=intbuf_tab%VARIABLES(25)
305C heat interface
306 intth = ipari(47,nin)
307 ikthe = ipari(92,nin)
308 iform = ipari(48,nin)
309 intply = ipari(66,nin)
310C
311 stiglo=-intbuf_tab%STFAC(1)
312 startt=intbuf_tab%VARIABLES(3)
313 stopt =intbuf_tab%VARIABLES(11)
314 IF(startt>tt) RETURN
315 IF(tt>stopt) RETURN
316C
317 fric =intbuf_tab%VARIABLES(1)
318 gap =intbuf_tab%VARIABLES(2)
319 gapmin=intbuf_tab%VARIABLES(13)
320 visc =intbuf_tab%VARIABLES(14)
321C VISCF =INTBUF_TAB%VARIABLES(15)
322 t_pfit = intbuf_tab%VARIABLES(15)
323 viscf = zero
324C
325 gapmax=intbuf_tab%VARIABLES(16)
326 kmin =intbuf_tab%VARIABLES(17)
327 kmax =intbuf_tab%VARIABLES(18)
328C
329 kthe = intbuf_tab%VARIABLES(20)
330 fheats = intbuf_tab%VARIABLES(21)
331 tint = intbuf_tab%VARIABLES(22)
332 fheatm = intbuf_tab%VARIABLES(41)
333 xthe =intbuf_tab%VARIABLES(33)
334 frad = intbuf_tab%VARIABLES(31)
335 drad = intbuf_tab%VARIABLES(32)
336 fcond = ipari(93,nin) ! function of variation of heat exchange as funct of distance
337 dcond = intbuf_tab%VARIABLES(34) ! max conduction distance
338 ifric = 0
339 IF(intth > 0) ifric =ipari(50,nin)
340C
341 penmin = intbuf_tab%VARIABLES(38)
342 eps = intbuf_tab%VARIABLES(39)
343C
344 viscfluid = intbuf_tab%VARIABLES(42)
345 sigmaxadh = intbuf_tab%VARIABLES(43)
346 viscadhfact = intbuf_tab%VARIABLES(44)
347C
348 pmax_gap = zero
349C
350 istif_msdt =ipari(97,nin)
351 dtstif = intbuf_tab%VARIABLES(48)
352C
353 ilev = ipari(20,nin)
354 nrtse = ipari(52,nin)
355C
356 intcarea = ipari(99,nin)
357C
358 ALLOCATE(index2(lindmax))
359C--- Corresponding Friction model
360 intfric=ipari(72,nin)
361 iorthfric = 0
362 nsetprts = 0
363 xfiltr_fric = zero
364 npartfric = 0
365 IF(intfric /= 0) THEN
366 tabcoupleparts_fric => intbuf_fric_tab(intfric)%TABCOUPLEPARTS_FRIC
367 tabcoef_fric => intbuf_fric_tab(intfric)%TABCOEF_FRIC
368 tabparts_fric => intbuf_fric_tab(intfric)%TABPARTS_FRIC
369 adparts_fric => intbuf_fric_tab(intfric)%ADPARTS_FRIC
370 xfiltr_fric = intbuf_fric_tab(intfric)%XFILTR_FRIC
371 nsetprts = intbuf_fric_tab(intfric)%NSETPRTS
372 npartfric = intbuf_fric_tab(intfric)%S_TABPARTS_FRIC
373 iorthfric = intbuf_fric_tab(intfric)%IORTHFRIC
374 ifricorth => intbuf_fric_tab(intfric)%IFRICORTH
375c MFROT = INTBUF_FRIC_TAB(INTFRIC)%FRICMOD ! These Flags are already put in Ipari
376c IFQ = INTBUF_FRIC_TAB(INTFRIC)%IFFILTER
377 ELSE
378 tabcoupleparts_fric => tabcoupleparts_fric_bid
379 tabparts_fric => tabparts_fric_bid
380 tabcoef_fric => tabcoef_fric_bid
381 adparts_fric => adparts_fric_bid
382 ifricorth => ifricorth_bid
383 IF (ifq/=0) xfiltr_fric = intbuf_tab%XFILTR(1)
384 ENDIF
385 efrict = zero
386C
387 ninloadp = ipari(95,nin) ! load pressure related to inter
388 dgaploadpmax = intbuf_tab%VARIABLES(46)
389C
390c----------------------------------------------------
391c radius of curvature: calculation of nodal normals (normalized)
392C IADM!=0 + Icurv!=0 non available (starter error).
393c----------------------------------------------------
394C-----Press-fit
395 set_ipari40_to_zero = .false.
396 IF (startt>zero.AND.t_pfit==zero) THEN
397 t_pfit=10000*dt12
398 intbuf_tab%VARIABLES(15) = t_pfit
399 END IF
400 IF (t_pfit > zero) THEN
401 IF (tt <= (startt+t_pfit) ) THEN
402 tncy = (tt+em05-startt)/t_pfit
403 ELSE
404 set_ipari40_to_zero = .true.
405 END IF
406 ELSE
407 ncy_pfit = ipari(40,nin)
408 IF (ncy_pfit >0 .AND. ncycle> ncy_pfit) THEN
409 set_ipari40_to_zero = .true.
410 ELSEIF (ncy_pfit>0) THEN
411 finc = one/ipari(40,nin)
412 tncy = (ncycle+1)*finc
413 END IF
414 END IF
415C----------------------------------------------------------------------
416C Second node previously impacted & Second node is leaving the contact
417C----------------------------------------------------------------------
418 nsnft= 1+(jtask-1)*nsn/ nthread
419 nsnlt= jtask*nsn/nthread
420
421 nsnrft= 1+(jtask-1)*nsnr/ nthread
422 nsnrlt= jtask*nsnr/nthread
423
424 IF(ivis2/=-1) THEN
425C
426 DO n=nsnft, nsnlt
427 IF(intbuf_tab%IRTLM(4*(n-1)+1) > 0 .AND. (intbuf_tab%TIME_S(2*(n-1)+1) == ep20 .OR.
428 . (intbuf_tab%IRTLM(4*(n-1)+2) < 0.AND.mod(-intbuf_tab%IRTLM(4*(n-1)+2),5)==0)) )THEN
429C No more contact (Reset Irtlm & PENE_OLD)
430 intbuf_tab%IRTLM(4*(n-1)+1)=0
431 intbuf_tab%IRTLM(4*(n-1)+2)=0
432 intbuf_tab%IRTLM(4*(n-1)+3)=0
433 intbuf_tab%IRTLM(4*(n-1)+4)=0
434C
435 intbuf_tab%SECND_FR(6*(n-1)+1:6*n) = zero
436 intbuf_tab%STIF_OLD(2*(n-1)+1:2*n)= zero
437 intbuf_tab%PENE_OLD(5*(n-1)+1:5*n)= zero
438C
439 END IF
440 END DO
441
442 DO n=nsnrft, nsnrlt
443c if(itafi(nin)%p(n)==29482)
444c . print *,'remote',ispmd+1,IRTLM_FI(NIN)%P(1,N),TIME_SFI(NIN)%P(N)
445 IF(irtlm_fi(nin)%P(1,n) > 0 .AND. (time_sfi(nin)%P(2*(n-1)+1) == ep20 .OR.
446 . (irtlm_fi(nin)%P(2,n) < 0.AND.mod(-irtlm_fi(nin)%P(2,n),5)==0)) )THEN
447C
448C No more contact (Reset Irtlm & PENE_OLD)
449 irtlm_fi(nin)%P(1,n)=0
450 irtlm_fi(nin)%P(2,n)=0
451 irtlm_fi(nin)%P(3,n)=0
452 irtlm_fi(nin)%P(4,n)=0
453C
454 secnd_frfi(nin)%P (1:6,n)=zero
455 pene_oldfi(nin)%P(1:5,n)=zero
456 stif_oldfi(nin)%P(1:2,n)=zero
457C
458 END IF
459 END DO
460 ELSE ! IVIS2 == -1
461 DO n=nsnft, nsnlt
462c if(itab(intbuf_tab%NSV(n))==27324)
463c . print *,'natif',ispmd+1,INTBUF_TAB%IRTLM(N),INTBUF_TAB%TIME_S(N)
464 IF(intbuf_tab%IRTLM(4*(n-1)+1) > 0 .AND. (intbuf_tab%TIME_S(2*(n-1)+1) == ep20 .OR.
465 . (intbuf_tab%IRTLM(4*(n-1)+2) < 0.AND.mod(-intbuf_tab%IRTLM(4*(n-1)+2),5)==0)) )THEN
466C
467C No more contact (Reset Irtlm & PENE_OLD)
468 intbuf_tab%IRTLM(4*(n-1)+1)=0
469 intbuf_tab%IRTLM(4*(n-1)+2)=0
470 intbuf_tab%IRTLM(4*(n-1)+3)=0
471 intbuf_tab%IRTLM(4*(n-1)+4)=0
472C
473 intbuf_tab%SECND_FR(6*(n-1)+1:6*n) = zero
474 intbuf_tab%STIF_OLD(2*(n-1)+1:2*n)= zero
475 intbuf_tab%PENE_OLD(5*(n-1)+1:5*n)= zero
476C
477 intbuf_tab%IF_ADH(n) = 0
478 END IF
479 END DO
480
481 DO n=nsnrft, nsnrlt
482c if(itafi(nin)%p(n)==29482)
483c . print *,'remote',ispmd+1,IRTLM_FI(NIN)%P(1,N),TIME_SFI(NIN)%P(N)
484 IF(irtlm_fi(nin)%P(1,n) > 0 .AND. (time_sfi(nin)%P(2*(n-1)+1) == ep20 .OR.
485 . (irtlm_fi(nin)%P(2,n) < 0.AND.mod(-irtlm_fi(nin)%P(2,n),5)==0)) )THEN
486C
487C No more contact (Reset Irtlm & PENE_OLD)
488 irtlm_fi(nin)%P(1,n)=0
489 irtlm_fi(nin)%P(2,n)=0
490 irtlm_fi(nin)%P(3,n)=0
491 irtlm_fi(nin)%P(4,n)=0
492C
493 secnd_frfi(nin)%P (1:6,n)=zero
494 pene_oldfi(nin)%P(1:5,n)=zero
495 stif_oldfi(nin)%P(1:2,n)=zero
496C
497 if_adhfi(nin)%P(n) = 0
498 END IF
499 END DO
500 ENDIF
501
502C-----------------------------------------------------------------------
503 CALL my_barrier
504 IF (inacti/=-1 .OR. set_ipari40_to_zero) THEN
505!$OMP SINGLE
506 ipari(40,nin) = 0
507!$OMP END SINGLE
508 ENDIF
509
510C-----------------------------------------------------------------------
511C Tag true impacts vs forces (CAND_N = -CAND_N)
512C-----------------------------------------------------------------------
513 i_stok_glo = intbuf_tab%I_STOK(2)
514C
515 nb_loc = i_stok_glo / nthread
516 IF (jtask==nthread) THEN
517 i_stok_loc = i_stok_glo-nb_loc*(nthread-1)
518 ELSE
519 i_stok_loc = nb_loc
520 ENDIF
521 debut = (jtask-1)*nb_loc
522
523 i_stok=0
524 DO i = debut+1, debut+i_stok_loc
525 IF(intbuf_tab%CAND_OPT_N(i)>0) THEN
526 i_stok = i_stok + 1
527 index2(i_stok) = i
528 ENDIF
529 END DO
530C
531C filter => keep only true contacts
532 CALL i25keepf(
533 1 i_stok ,index2 ,intbuf_tab%CAND_OPT_N,intbuf_tab%CAND_OPT_E,nin ,
534 2 nsn ,nsnr ,inacti ,intbuf_tab%MSEGLO ,intbuf_tab%IRTLM ,
535 3 intbuf_tab%PENM ,intbuf_tab%PENE_OLD ,jtask ,itab,
536 4 intbuf_tab%NSV ,intbuf_tab%SECND_FR,intbuf_tab%TIME_S,
537 . intbuf_tab%STIF_OLD)
538C
539 CALL my_barrier
540C
541C-----------------------------------------------------------------------
542C
543C (re) static decoupage
544C
545 i_stok_glo = intbuf_tab%I_STOK(2)
546C
547 nb_loc = i_stok_glo / nthread
548 IF (jtask==nthread) THEN
549 i_stok_loc = i_stok_glo-nb_loc*(nthread-1)
550 ELSE
551 i_stok_loc = nb_loc
552 ENDIF
553 debut = (jtask-1)*nb_loc
554
555 i_stok = 0
556C
557C recalculation of istok
558C
559 DO i = jtask, i_stok_glo, nthread
560 IF(intbuf_tab%CAND_OPT_N(i)>0) THEN
561 i_stok = i_stok + 1
562 index2(i_stok) = i
563 ENDIF
564 ENDDO
565C-----------------------------------------------------------------------
566 sfsavparit = 0
567 DO i=1,nisub+1
568 IF(isensint(i)/=0) THEN
569 sfsavparit = sfsavparit + 1
570 ENDIF
571 ENDDO
572 IF (sfsavparit /= 0) THEN
573 ALLOCATE(fsavparit(nisub+1,11,i_stok),stat=ierror)
574 IF(ierror/=0) THEN
575 CALL ancmsg(msgid=19,anmode=aninfo,
576 . c1='(/INTER/TYPE25)')
577 CALL arret(2)
578 ENDIF
579 fsavparit(1:nisub+1,1:11,1:i_stok) = zero
580 ELSE
581 ALLOCATE(fsavparit(0,0,0),stat=ierror)
582 IF(ierror/=0) THEN
583 CALL ancmsg(msgid=19,anmode=aninfo,
584 . c1='(/INTER/TYPE25)')
585 CALL arret(2)
586 ENDIF
587 ENDIF
588C-----------------------------------------------------------------------
589C Forces computation
590C-----------------------------------------------------------------------
591 DO nft = 0 , i_stok - 1 , nvsiz
592 jlt = min( nvsiz, i_stok - nft )
593C preparation CANDIDATES retenus
594 CALL i25cdcor3(
595 1 jlt,index2(nft+1),intbuf_tab%CAND_OPT_E,intbuf_tab%CAND_OPT_N,
596 2 cand_e_n,cand_n_n )
597C cand_n and cand_e replaced by cand_n_n and cand_e_n
598C Extraction of global data to local arrays
599 CALL i25cor3_3(
600 1 jlt ,x ,intbuf_tab%IRECTM,intbuf_tab%NSV ,cand_e_n ,
601 2 cand_n_n ,intbuf_tab%STFM ,intbuf_tab%STFNS,stif ,
602 . intbuf_tab%EDGE_BISECTOR,
603 3 igsti ,kmin ,kmax ,ms ,msi ,
604 3 xi ,yi ,zi ,vxi ,vyi ,
605 4 vzi ,ix1 ,ix2 ,ix3 ,ix4 ,
606 5 nsvg ,nsn ,v ,kinet ,kini ,
607 6 nin ,intbuf_tab%ADMSR ,intbuf_tab%IRTLM,subtria ,
608 7 xx ,yy ,zz ,intbuf_tab%LBOUND,ibound ,
609 8 nnx ,nny ,nnz ,
610 9 vx1 ,vx2 ,vx3 ,vx4 ,
611 a vy1 ,vy2 ,vy3 ,vy4 ,
612 b vz1 ,vz2 ,vz3 ,vz4 ,
613 c nodnx_sms ,nsms ,index2(nft+1),intbuf_tab%PENM,intbuf_tab%LBM,
614 d intbuf_tab%LCM,pene ,lb , lc ,
615 e intbuf_tab%GAP_NM ,gap_nm ,intbuf_tab%GAP_S,gaps,igap ,
616 f intbuf_tab%GAP_SL,intbuf_tab%GAP_ML,gapmxl,intfric,intbuf_tab%IPARTFRICS,
617 g ipartfricsi,intbuf_tab%IPARTFRICM,ipartfricmi,intbuf_tab%AREAS,areasi,
618 h ivis2 ,intbuf_tab%MVOISIN,mvoisn,iorthfric,intbuf_tab%IREP_FRICM,
619 i intbuf_tab%DIR_FRICM ,irep_fricmi ,dir_fricmi ,x1 ,y1 ,
620 j z1 ,x2 ,y2 ,z2 ,x3 ,
621 k y3 ,z3 ,x4 ,y4 ,z4 ,
622 l intth ,temp ,tempi ,intbuf_tab%IELES ,ielesi ,
623 m intbuf_tab%IELEM,ielemi,istif_msdt,dtstif ,intbuf_tab%STIFMSDT_S,
624 n intbuf_tab%STIFMSDT_M,nrtm ,interfaces%PARAMETERS)
625 iknon(1:jlt) = 0
626 CALL i_corpfit3(
627 1 jlt ,intbuf_tab%STFM ,intbuf_tab%STFNS,stif ,nsn ,
628 2 cand_e_n ,cand_n_n,nin ,igsti ,kmin ,
629 3 kmax ,inacti ,ipari(40,nin),tncy ,iknon )
630C
631 jlt_new = 0
632C
633 CALL i25dst3_3(
634 1 jlt ,cand_n_n ,cand_e_n ,cn_loc ,ce_loc ,
635 2 intbuf_tab%IRTLM,xx ,yy ,zz ,gap_nm ,
636 3 xi ,yi ,zi ,gaps ,gapmxl ,
637 4 isharp ,nnx ,nny ,nnz ,
638 5 n1 ,n2 ,n3 ,h1 ,h2 ,
639 5 h3 ,h4 ,nin ,nsn ,ix1 ,
640 6 ix2 ,ix3 ,ix4 ,nsvg ,stif ,
641 7 inacti ,kini ,itab ,lb ,lc ,
642 8 penmin ,eps ,pene ,intbuf_tab%PENE_OLD,subtria,
643 9 gapv ,ivis2 ,intbuf_tab%IF_ADH,ifadhi ,base_adh ,
644 a mvoisn ,ibound ,intbuf_tab%VTX_BISECTOR ,dist, tt)
645C
646 DO i = 1 ,jlt
647C
648C Needs to compute STIF_OLD even if PENE ==0 (cf INACTI=5)
649C IF(PENE(I)/=ZERO.AND.STIF(I)/=ZERO)THEN
650 IF(stif(i)>zero)THEN
651 IF(pene(i)==zero)THEN
652 n = cand_n_n(i)
653 IF(n <= nsn)THEN
654 intbuf_tab%STIF_OLD(2*(n-1)+1)=max(intbuf_tab%STIF_OLD(2*(n-1)+1),stif(i))
655 ELSE
656 stif_oldfi(nin)%P(1,n-nsn) = max(stif_oldfi(nin)%P(1,n-nsn),stif(i))
657 END IF
658 ELSE
659 jlt_new = jlt_new + 1
660 END IF
661 END IF
662 ENDDO
663C
664 IF(intth==0.AND.jlt_new == 0.AND.(ninloadp == 0.OR.dgaploadpmax==zero))cycle
665 ipari(29,nin) = 1
666C
667 IF (debug(3)>=1) nb_impct = nb_impct + jlt_new
668 IF (imonm > 0 .AND. jtask == 1) CALL startime(timers,20)
669
670C-------------------------------------------------------------------------------
671C Friction model : computation of friction coefficients based on Material of connected Parts
672C-------------------------------------------------------------------------------
673 IF(jtask==1) CALL startime(timers,macro_timer_fric)
674 jj = 0
675 IF(iorthfric > 0) THEN
676 CALL frictionparts_model_ortho(
677 1 intfric ,jlt ,ipartfricsi ,ipartfricmi ,adparts_fric ,
678 2 nsetprts ,tabcoupleparts_fric,npartfric,tabparts_fric,tabcoef_fric ,
679 3 fric ,viscf ,intbuf_tab%FRIC_P,fric_coefs , fricc ,
680 4 viscffric ,nty ,mfrot ,iorthfric , fric_coefs2,
681 5 fricc2 ,viscffric2 ,ifricorth ,nforth , nfisot ,
682 6 indexorth ,indexisot ,jj ,irep_fricmi ,dir_fricmi ,
683 7 ix3 ,ix4 ,x1 ,y1 , z1 ,
684 8 x2 ,y2 ,z2 ,x3 , y3 ,
685 9 z3 ,x4 ,y4 ,z4 ,ce_loc ,
686 a dir1 ,dir2 )
687 ELSE
688 nforth = 0
689 nfisot = 0
690 CALL frictionparts_model_isot(
691 1 intfric ,jlt ,ipartfricsi ,ipartfricmi ,adparts_fric ,
692 2 nsetprts ,tabcoupleparts_fric,npartfric,tabparts_fric,tabcoef_fric ,
693 3 fric ,viscf ,intbuf_tab%FRIC_P,fric_coefs , fricc ,
694 4 viscffric ,nty ,mfrot ,iorthfric ,ifric ,
695 5 jj , tint ,tempi ,npc ,tf ,
696 6 temp , h1 ,h2 ,h3 ,h4 ,
697 7 ix1 , ix2 ,ix3 ,ix4 ,iform )
698 ENDIF
699 IF(jtask==1) CALL stoptime(timers,macro_timer_fric)
700
701 CALL i25for3(output,
702 1 jlt ,a ,v ,ibc ,icodt ,
703 2 fsav ,ms ,visc ,
704 3 viscf ,noint ,intbuf_tab%STFNS,itab ,cn_loc ,
705 4 stiglo ,stifn ,stif ,inacti ,index2(nft+1),
706 5 n1 ,n2 ,n3 ,h1 ,h2 ,
707 6 h3 ,h4 ,fcont ,pene ,nrtm ,
708 7 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
709 8 ivis2 ,neltst ,ityptst ,dt2t ,
710 a kinet ,newfront ,isecin ,nstrf ,secfcum ,
711 b x ,intbuf_tab%IRECTM,ce_loc ,mfrot ,ifq ,
712 b intbuf_tab%SECND_FR,xfiltr_fric,ibag ,icontact ,intbuf_tab%IRTLM,
713 e viscn ,vxi ,vyi ,vzi ,msi ,
714 f kini ,nin ,nisub ,intbuf_tab%LISUB,intbuf_tab%ADDSUBS,
715 g intbuf_tab%ADDSUBM,intbuf_tab%LISUBS,intbuf_tab%LISUBM,
716 . intbuf_tab%INFLG_SUBS,intbuf_tab%INFLG_SUBM,
717 h fsavsub ,ipari(33,nin),ipari(39,nin),fncont ,ftcont ,
718 i nsn ,xx ,yy ,zz ,
719 j xi ,yi ,zi ,anglmi ,padm ,
720 k iadm ,rcurvi ,rcontact ,acontact ,pcontact ,
721 n mskyi_sms ,iskyi_sms ,nsms ,cand_n_n ,intbuf_tab%PENE_OLD,
722 o intbuf_tab%STIF_OLD,intbuf_tab%MBINFLG,ilev ,igsti ,kmin ,
723 p intply ,nm1 ,nm2 ,nm3 ,
724 q intbuf_tab%MSEGTYP24,jtask ,isensint ,
725 t fsavparit(1,1,nft+1),h3d_data,fricc ,viscffric ,fric_coefs, gapv,
726 u viscfluid , sigmaxadh , viscadhfact, ifadhi , areasi , base_adh ,
727 v iorthfric ,fric_coefs2 ,fricc2 ,viscffric2,nforth ,nfisot ,
728 w indexorth , indexisot ,dir1 ,dir2 ,apinch ,stifpinch,
729 c fni ,fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
730 d fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
731 e fy4 ,fz4 ,fxi ,fyi ,fzi ,
732 c intth ,drad ,fheats ,fheatm ,qfricint(nin),
733 d efrict ,tagncont ,kloadpinter ,loadpinter ,loadp_hyd_inter,
734 e intbuf_tab%TYPSUB,ipari(40,nin),ninloadp,dgaploadint,s_loadpinter,
735 f dist ,dgaploadpmax,interefric ,intcarea ,interfaces%PARAMETERS)
736C
737 IF (imonm > 0 .AND. jtask == 1) CALL stoptime(timers,20)
738
739 IF(intth > 0) THEN
740
741 CALL i25therm(
742 1 jlt ,kthe ,tempi ,areasi ,ielesi ,
743 2 ielemi ,gapv ,ikthe ,xthe ,fni ,
744 3 npc ,tf ,frad ,drad ,efrict ,
745 4 fheats ,fheatm ,condint,iform ,temp ,
746 5 h1 ,h2 ,h3 ,h4 ,fcond ,
747 6 dcond ,tint ,xi ,yi ,zi ,
748 7 x1 ,y1 ,z1 ,x2 ,y2 ,
749 8 z2 ,x3 ,y3 ,z3 ,x4 ,
750 9 y4 ,z4 ,ix1 ,ix2 ,ix3 ,
751 a ix4 ,phi ,phi1 ,phi2 ,phi3 ,
752 b phi4 ,pm ,nsvg ,itab ,theaccfact)
753
754 ENDIF
755
756
757 CALL i25ass3(
758 1 jlt ,nsvg ,itab ,ce_loc ,
759 2 jtask ,nin ,noint ,intply ,a ,
760 3 stif ,stifn ,niskyfi ,fskyi ,isky ,
761 4 n1 ,n2 ,n3 ,h1 ,h2 ,
762 5 h3 ,h4 ,ix1 ,ix2 ,ix3 ,
763 6 ix4 ,intth ,fthe ,ftheskyi ,
764 7 phi ,phi1 ,phi2 ,phi3 ,phi4 ,
765 8 fni , intbuf_tab%MSEGTYP24 ,apinch ,
766 . stifpinch ,
767 9 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
768 a fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
769 b fy4 ,fz4 ,fxi ,fyi ,fzi ,
770 f iform ,condint ,condn ,condnskyi ,nodadt_therm)
771
772 ENDDO
773C-----------------------------------------------------------------------
774 IF (sfsavparit /= 0)THEN
775 CALL sum_6_float_sens(fsavparit, nisub+1, 11, i_stok,1,i_stok,
776 . fbsav6, 12, 6, dimfb, isensint )
777 ENDIF
778 DEALLOCATE (fsavparit)
779C-----------------------------------------------------------------------
780 CALL my_barrier
781C-----------------------------------------------------------------------
782 DO n=nsnft, nsnlt
783 IF(intbuf_tab%IRTLM(4*(n-1)+1) < 0)
784 . intbuf_tab%IRTLM(4*(n-1)+1) = -intbuf_tab%IRTLM(4*(n-1)+1)
785 END DO
786C
787 DO n=nsnrft, nsnrlt
788 IF(irtlm_fi(nin)%P(1,n) < 0) irtlm_fi(nin)%P(1,n) = -irtlm_fi(nin)%P(1,n)
789 END DO
790C----------------------------------------------------------------------
791C 2- EDGES
792C----------------------------------------------------------------------
793 IF(nedge==0) GOTO 500
794C-----------------------------------------------------------------------
795C
796 CALL my_barrier
797C
798 i_stok = intbuf_tab%I_STOK_E(1)
799C this part is done in parallel after the calculation of the forces of the elements
800C static decoupage
801 nb_loc = i_stok / nthread
802 IF (jtask==nthread) THEN
803 i_stok_loc = i_stok-nb_loc*(nthread-1)
804 ELSE
805 i_stok_loc = nb_loc
806 ENDIF
807 debut = (jtask-1)*nb_loc
808 i_stok = 0
809C recalculation of istok
810C WRITE(6,*) "NEDGE=",NEDGE
811 DO i = debut+1, debut+i_stok_loc
812
813
814C =========== DEBUG
815#ifdef D_EM
816 eidm = intbuf_tab%ledge(nledge*(intbuf_tab%candm_e2e(i)-1) + 8)
817 eids = abs(intbuf_tab%cands_e2e(i))
818 if(eids > nedge) then
819 eids = ledge_fie(nin)%P(e_global_id,eids-nedge)
820 else
821 eids = intbuf_tab%ledge(nledge*(eids-1)+8)
822 endif
823 if(eidm == d_em) then
824 IF(intbuf_tab%CANDS_E2E(i) < 0) THEN
825 write(6,"(A,I10,A,2I10,Z20)") __file__,i,"E2E conserve",eidm,eids, intbuf_tab%CAND_P(i)
826 ELSE
827 write(6,"(A,I10,A,2I10,Z20)") __file__,i,"E2E exclude",eidm,eids, intbuf_tab%CAND_P(i)
828 ENDIF
829 endif
830#endif
831C ============== End debug
832
833
834 IF(intbuf_tab%CANDS_E2E(i) < 0) THEN
835 i_stok = i_stok + 1
836 index2(i_stok) = i
837C inbuf == cand_S
838 intbuf_tab%CANDS_E2E(i) = -intbuf_tab%CANDS_E2E(i)
839 ELSE ! Reset CAND_P
840 intbuf_tab%CAND_P(i) = zero
841 ENDIF
842 ENDDO
843C
844 sfsavparit = 0
845 DO i=1,nisub+1
846 IF(isensint(i)/=0) THEN
847 sfsavparit = sfsavparit + 1
848 ENDIF
849 ENDDO
850 IF (sfsavparit /= 0) THEN
851 ALLOCATE(fsavparit(nisub+1,11,i_stok))
852 DO j=1,i_stok
853 DO i=1,11
854 DO h=1,nisub+1
855 fsavparit(h,i,j) = zero
856 ENDDO
857 ENDDO
858 ENDDO
859 ELSE
860 ALLOCATE(fsavparit(0,0,0))
861 ENDIF
862C
863 DO nft = 0 , i_stok - 1 , nvsiz
864 jlt = min( nvsiz, i_stok - nft )
865C preparation CANDIDATES retenus
866 CALL i25cdcor3(
867 1 jlt,index2(nft+1),intbuf_tab%CANDM_E2E,intbuf_tab%CANDS_E2E,cm_loc,
868 2 cs_loc)
869 CALL i25cor3e(
870 1 jlt ,intbuf_tab%LEDGE,intbuf_tab%IRECTM,x ,v ,
871 2 cs_loc ,cm_loc ,intbuf_tab%STFE ,ms ,ex ,
872 3 ey ,ez ,fx ,fy ,fz ,
873 4 stif ,xxs1 ,xxs2 ,xys1 ,xys2 ,
874 5 xzs1 ,xzs2 ,xxm1 ,xxm2 ,xym1 ,
875 6 xym2 ,xzm1 ,xzm2 ,vxs1 ,vxs2 ,
876 7 vys1 ,vys2 ,vzs1 ,vzs2 ,vxm1 ,
877 8 vxm2 ,vym1 ,vym2 ,vzm1 ,vzm2 ,
878 9 ms1 ,ms2 ,mm1 ,mm2 ,ne1 ,
879 a ne2 ,me1 ,me2 ,nedge ,nin ,
880 c intbuf_tab%STFAC,nodnx_sms ,nsms ,intbuf_tab%GAPE,gapve,
881 d iedge ,intbuf_tab%ADMSR,intbuf_tab%LBOUND,intbuf_tab%EDGE_BISECTOR,
882 e intbuf_tab%VTX_BISECTOR ,igap0,
883 f iam ,jam ,ibm ,jbm ,ias ,
884 g jas ,ibs ,jbs ,itab ,edge_id ,
885 h intfric ,intbuf_tab%IPARTFRIC_E ,ipartfricsi ,ipartfricmi,
886 i igap ,intbuf_tab%GAP_E_L,igsti ,kmin ,kmax ,
887 j istif_msdt ,dtstif ,intbuf_tab%STIFMSDT_EDG,interfaces%PARAMETERS)
888 CALL i_cor_epfit3(
889 1 jlt ,intbuf_tab%STFE,stif ,cs_loc ,cm_loc ,
890 2 nedge ,nin ,inacti ,ipari(40,nin),tncy)
891
892 CALL i25dst3e(
893 1 jlt ,cs_loc,cm_loc ,hs1 ,hs2 ,
894 2 hm1 ,hm2 ,nx ,ny ,nz ,
895 3 stif ,ne1 ,ne2 ,me1 ,me2 ,
896 4 jlt_new,xxs1 ,xxs2 ,xys1 ,xys2 ,
897 5 xzs1 ,xzs2 ,xxm1 ,xxm2 ,xym1 ,
898 6 xym2 ,xzm1 ,xzm2 ,vxs1 ,vxs2 ,
899 7 vys1 ,vys2 ,vzs1 ,vzs2 ,vxm1 ,
900 8 vxm2 ,vym1 ,vym2 ,vzm1 ,vzm2 ,
901 9 ms1 ,ms2 ,mm1 ,mm2 ,iedge ,
902 b nsms ,index2(nft+1),intfric ,ipartfricsi,
903 . ipartfricmi,
904 c gapve ,ex ,ey ,ez ,fx ,
905 d fy ,fz ,intbuf_tab%LEDGE,intbuf_tab%IRECTM,
906 . intbuf_tab%CAND_P,
907 e iam ,jam ,ibm ,jbm ,ias ,
908 f jas ,ibs ,jbs ,itab ,edge_id,
909 g dgaploadpmax)
910
911C
912 IF (imonm > 0 .AND. jtask == 1) CALL startime(timers,20)
913
914
915 jlt = jlt_new
916 IF(jlt_new/=0) THEN
917 IF (imonm > 0 .AND. jtask == 1) CALL startime(timers,20)
918 ipari(29,nin) = 1
919 IF (debug(3)>=1) nb_impct = nb_impct + jlt
920
921C-------------------------------------------------------------------------------
922C Friction model : computation of friction coefficients based on Material of connected Parts
923C-------------------------------------------------------------------------------
924 IF(mfrot == 0 ) THEN
925 jj = 0
926 ifric =0
927 CALL frictionparts_model_isot(
928 1 intfric ,jlt ,ipartfricsi ,ipartfricmi ,adparts_fric ,
929 2 nsetprts ,tabcoupleparts_fric,npartfric,tabparts_fric,tabcoef_fric ,
930 3 fric ,viscf ,intbuf_tab%FRIC_P,fric_coefs , fricc ,
931 4 viscffric ,nty ,mfrot ,iorthfric ,ifric ,
932 5 jj , tint ,tempi ,npc ,tf ,
933 6 temp , h1 ,h2 ,h3 ,h4 ,
934 7 ix1 , ix2 ,ix3 ,ix4 ,iform )
935 ELSE
936 DO i=1,jlt
937 fricc(i) = zero
938 ENDDO
939 ENDIF
940
941 CALL i25for3e(
942 1 jlt ,a ,v ,ibc ,icodt ,
943 2 fsav ,gap ,fric ,ms ,visc ,
944 3 viscf ,noint ,itab ,cs_loc ,cm_loc ,
945 4 stiglo ,stifn ,stif ,fskyi ,isky ,
946 5 fcont ,dt2t ,ibm ,hs1 ,
947 6 hs2 ,hm1 ,hm2 ,ne1 ,ne2 ,
948 7 me1 ,me2 ,ivis2 ,neltst ,ityptst ,
949 8 nx ,ny ,nz ,gapve ,inacti ,
950 9 index2(nft+1),intbuf_tab%CAND_P,niskyfie ,newfront ,isecin ,
951 a nstrf ,secfcum ,viscn ,nedge ,ms1 ,
952 b ms2 ,mm1 ,mm2 ,vxs1 ,vys1 ,
953 c vzs1 ,vxs2 ,vys2 ,vzs2 ,vxm1 ,
954 d vym1 ,vzm1 ,vxm2 ,vym2 ,vzm2 ,
955 e nin ,nisub ,intbuf_tab%LISUB,intbuf_tab%ADDSUBE,
956 . intbuf_tab%LISUBE,
957 f intbuf_tab%INFLG_SUBE ,fsavsub,mskyi_sms ,iskyi_sms ,nsms ,
958 g jtask ,isensint ,fsavparit(1,1,nft+1),nft,h3d_data ,
959 h ilev ,intbuf_tab%EBINFLG, edge_id,fricc,ifq ,
960 i intbuf_tab%FTSAVX_E,intbuf_tab%FTSAVY_E, intbuf_tab%FTSAVZ_E ,
961 . intbuf_tab%IFPEN_E ,
962 j tagncont ,kloadpinter ,loadpinter ,loadp_hyd_inter, intbuf_tab%TYPSUB,
963 k startt ,ninloadp,dgaploadint,s_loadpinter)
964
965 IF (imonm > 0 .AND. jtask == 1) CALL stoptime(timers,20)
966
967
968
969 ENDIF
970 ENDDO
971
972 IF (sfsavparit /= 0)THEN
973 CALL sum_6_float_sens(fsavparit, nisub+1, 11, i_stok,1,i_stok,
974 . fbsav6, 12, 6, dimfb, isensint )
975 ENDIF
976 DEALLOCATE (fsavparit)
977C
978C-----------------------------------------------------------------------
979C
980 CALL my_barrier
981C
982 i_stok = intbuf_tab%I_STOK_E(2)
983C this part is done in parallel after the calculation of the forces of the elements
984C static decoupage
985 nb_loc = i_stok / nthread
986 IF (jtask==nthread) THEN
987 i_stok_loc = i_stok-nb_loc*(nthread-1)
988 ELSE
989 i_stok_loc = nb_loc
990 ENDIF
991C WRITE(6,*) "I_STOK_LOC=",I_STOK_LOC
992 debut = (jtask-1)*nb_loc
993 i_stok = 0
994C recalculation of istok
995 DO i = debut+1, debut+i_stok_loc
996C =========== DEBUG
997#ifdef D_EM
998C eidm = intbuf_tab%ledge(NLEDGE*(intbuf_tab%candm_e2e(i)-1) + 8)
999 eids = abs(intbuf_tab%cands_e2S(i))
1000 if(eids > nedge) then
1001 eids = ledge_fie(nin)%P(e_global_id,eids-nedge)
1002 else
1003 eids = intbuf_tab%ledge(nledge*(eids-1)+8)
1004 endif
1005 if(eids == d_es) then
1006 IF(intbuf_tab%CANDS_E2S(i) < 0) THEN
1007 write(6,"(A,I10,A,2I10,4Z20)") __file__,i,"E2S conserve ",eidm,eids,intbuf_tab%CAND_PS(4*(i-1)+1:4*(i-1)+4)
1008 ELSE
1009C write(6,"(A,I10,A,2I10,Z20)") __FILE__,i," exclude",eidm,eids, intbuf_tab%CAND_PS(i)
1010 ENDIF
1011 endif
1012#endif
1013C ============== End debug
1014
1015 IF(intbuf_tab%CANDS_E2S(i) < 0) THEN
1016 i_stok = i_stok + 1
1017 index2(i_stok) = i
1018C inbuf == cand_S
1019 intbuf_tab%CANDS_E2S(i) = -intbuf_tab%CANDS_E2S(i)
1020 ELSE ! Reset CAND_P
1021 intbuf_tab%CAND_PS(4*(i-1)+1:4*(i-1)+4) = zero
1022 ENDIF
1023 ENDDO
1024C WRITE(6,*) "INDEX2(1:,",I_STOK,INTBUF_TAB%I_STOK_E(2),LINDMAX
1025
1026C
1027 sfsavparit = 0
1028 DO i=1,nisub+1
1029 IF(isensint(i)/=0) THEN
1030 sfsavparit = sfsavparit + 1
1031 ENDIF
1032 ENDDO
1033 IF (sfsavparit /= 0) THEN
1034 ALLOCATE(fsavparit(nisub+1,11,i_stok))
1035 DO j=1,i_stok
1036 DO i=1,11
1037 DO h=1,nisub+1
1038 fsavparit(h,i,j) = zero
1039 ENDDO
1040 ENDDO
1041 ENDDO
1042 ELSE
1043 ALLOCATE(fsavparit(0,0,0))
1044 ENDIF
1045C
1046 DO nft = 0 , i_stok - 1 , nvsiz
1047 jlt = min( nvsiz, i_stok - nft )
1048C preparation CANDIDATES retenus
1049 CALL i25cdcor3_e2s(
1050 1 jlt,index2(nft+1),intbuf_tab%CANDM_E2S,intbuf_tab%CANDS_E2S,
1051 2 cm_loc,cs_loc )
1052 CALL i25cor3_e2s(
1053 1 jlt ,intbuf_tab%LEDGE,intbuf_tab%IRECTM,x ,v ,
1054 2 cs_loc ,cm_loc ,intbuf_tab%STFM ,ms ,ex ,
1055 3 ey ,ez ,fx ,fy ,fz ,
1056 4 stife ,xxs1 ,xxs2 ,xys1 ,xys2 ,
1057 5 xzs1 ,xzs2 ,xxm1 ,xxm2 ,xym1 ,
1058 6 xym2 ,xzm1 ,xzm2 ,vxs1 ,vxs2 ,
1059 7 vys1 ,vys2 ,vzs1 ,vzs2 ,vxm1 ,
1060 8 vxm2 ,vym1 ,vym2 ,vzm1 ,vzm2 ,
1061 9 ms1 ,ms2 ,mm1 ,mm2 ,ns1 ,
1062 a ns2 ,m1 ,m2 ,nedge ,nin ,
1063 c intbuf_tab%STFAC,nodnx_sms ,nsmse ,intbuf_tab%GAPE,gapve ,
1064 d iedge ,intbuf_tab%ADMSR,intbuf_tab%LBOUND,intbuf_tab%EDGE_BISECTOR,
1065 e intbuf_tab%VTX_BISECTOR ,typedgs ,ias ,jas ,ibs ,
1066 f jbs ,iam ,intbuf_tab%STFE,edge_id, itab,
1067 g intfric ,intbuf_tab%IPARTFRIC_E ,ipartfric_es ,ipartfric_em,
1068 h igsti ,kmin ,kmax ,intbuf_tab%E2S_NOD_NORMAL,nadmsr,
1069 i normaln1 ,normaln2 ,normalm1 ,normalm2 , istif_msdt,
1070 j dtstif ,intbuf_tab%STIFMSDT_EDG,intbuf_tab%STIFMSDT_M,nrtm,interfaces%PARAMETERS)
1071
1072 CALL i25dst3_e2s(
1073 1 jlt ,cs_loc,cm_loc ,hs1 ,hs2 ,
1074 2 hm1 ,hm2 ,nx ,ny ,nz ,
1075 3 stife ,ns1 ,ns2 ,m1 ,m2 ,
1076 4 jlt_new,xxs1 ,xxs2 ,xys1 ,xys2 ,
1077 5 xzs1 ,xzs2 ,xxm1 ,xxm2 ,xym1 ,
1078 6 xym2 ,xzm1 ,xzm2 ,vxs1 ,vxs2 ,
1079 7 vys1 ,vys2 ,vzs1 ,vzs2 ,vxm1 ,
1080 8 vxm2 ,vym1 ,vym2 ,vzm1 ,vzm2 ,
1081 9 ms1 ,ms2 ,mm1 ,mm2 ,iedge ,
1082 b nsmse ,index2(nft+1),intfric ,ipartfric_es,
1083 . ipartfric_em,
1084 c gapve ,ex ,ey ,ez ,fx ,
1085 d fy ,fz ,intbuf_tab%LEDGE,intbuf_tab%IRECTM,x ,
1086 e intbuf_tab%CAND_PS,typedgs ,ias ,jas ,ibs ,
1087 f jbs ,iam ,itab ,indx1,indx2,
1088 g cs_loc4,cm_loc4,edge_id, nedge, nin,
1089 h dgaploadpmax,normaln1,normaln2,normalm1,normalm2)
1090C
1091 assert(4*jlt>=jlt_new)
1092
1093 jlt=jlt_new
1094 IF(jlt_new/=0) THEN
1095 IF (imonm > 0 .AND. jtask == 1) CALL startime(timers,20)
1096 ipari(29,nin) = 1
1097 IF (debug(3)>=1) nb_impct = nb_impct + jlt
1098
1099C-------------------------------------------------------------------------------
1100C Friction model : computation of friction coefficients based on Material of connected Parts
1101C-------------------------------------------------------------------------------
1102 IF(mfrot == 0 ) THEN
1103 jj = 0
1104 ifric = 0
1105 CALL frictionparts_model_isot(
1106 1 intfric ,jlt ,ipartfric_es ,ipartfric_em ,adparts_fric ,
1107 2 nsetprts ,tabcoupleparts_fric,npartfric,tabparts_fric,tabcoef_fric ,
1108 3 fric ,viscf ,intbuf_tab%FRIC_P,fric_coefs , fricc_e ,
1109 4 viscffric_e ,nty ,mfrot ,iorthfric ,ifric ,
1110 5 jj , tint ,tempi ,npc ,tf ,
1111 6 temp , h1 ,h2 ,h3 ,h4 ,
1112 7 ix1 , ix2 ,ix3 ,ix4 ,iform )
1113 ELSE
1114 DO i=1,jlt
1115 fricc_e(i) = zero
1116 ENDDO
1117 ENDIF
1118
1119 assert(jlt < 4*mvsiz)
1120 CALL i25for3_e2s(
1121 1 jlt ,a ,v ,ibc ,icodt ,
1122 2 fsav ,gap ,fric ,ms ,visc ,
1123 3 viscf ,noint ,itab ,cs_loc4 ,cm_loc4 ,
1124 4 stiglo ,stifn ,stife ,fskyi ,isky ,
1125 5 fcont ,dt2t ,nrtm,intbuf_tab%MSEGTYP24,hs1 ,
1126 6 hs2 ,hm1 ,hm2 ,ns1 ,ns2 ,
1127 7 m1 ,m2 ,ivis2 ,neltst ,ityptst ,
1128 8 nx ,ny ,nz ,gapve ,inacti ,
1129 9 index2(nft+1),intbuf_tab%CAND_PS,niskyfie ,newfront ,isecin ,
1130 a nstrf ,secfcum ,viscn ,nedge ,ms1 ,
1131 b ms2 ,mm1 ,mm2 ,vxs1 ,vys1 ,
1132 c vzs1 ,vxs2 ,vys2 ,vzs2 ,vxm1 ,
1133 d vym1 ,vzm1 ,vxm2 ,vym2 ,vzm2 ,
1134 e nin ,nisub ,intbuf_tab%LISUB,intbuf_tab%ADDSUBE,intbuf_tab%ADDSUBM,
1135 f intbuf_tab%LISUBE ,intbuf_tab%LISUBM ,intbuf_tab%INFLG_SUBE ,intbuf_tab%INFLG_SUBM ,
1136 . fsavsub ,
1137 g mskyi_sms ,iskyi_sms ,nsmse ,jtask ,isensint ,
1138 h fsavparit(1,1,nft+1),nft ,h3d_data ,indx1 ,indx2 ,
1139 i ilev ,intbuf_tab%MBINFLG, edge_id,nedge_rem ,fricc_e ,
1140 j ifq ,intbuf_tab%FTSAVX_E2S,intbuf_tab%FTSAVY_E2S, intbuf_tab%FTSAVZ_E2S ,
1141 . intbuf_tab%IFPEN_E2S ,
1142 k tagncont ,kloadpinter ,loadpinter ,loadp_hyd_inter,intbuf_tab%TYPSUB,
1143 o startt ,ninloadp,dgaploadint,s_loadpinter)
1144
1145 IF (imonm > 0 .AND. jtask == 1) CALL stoptime(timers,20)
1146 ENDIF
1147 ENDDO
1148
1149 IF (sfsavparit /= 0)THEN
1150 CALL sum_6_float_sens(fsavparit, nisub+1, 11, i_stok,1,i_stok,
1151 . fbsav6, 12, 6, dimfb, isensint )
1152 ENDIF
1153 DEALLOCATE (fsavparit)
1154C
1155 CALL my_barrier
1156C
1157C-----------------------------------------------------------------------
1158 500 CONTINUE
1159 DEALLOCATE(index2)
1160 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
i_corpfit3
subroutine i_corpfit3(jlt, stf, stfn, stif, nsn, cand_e, cand_n, nin, igsti, kmin, kmax, inacti, ncfit, tncy, iknon)
Definition i24cor3.F:955
i_cor_epfit3
subroutine i_cor_epfit3(jlt, stfe, stif, cand_s, cand_m, nedge, nin, inacti, ncfit, tncy)
Definition i24cor3.F:1059
i25cor3_3
subroutine i25cor3_3(jlt, x, irect, nsv, cand_e, cand_n, stf, stfn, stif, nod_normal, igsti, kmin, kmax, ms, msi, xi, yi, zi, vxi, vyi, vzi, ix1, ix2, ix3, ix4, nsvg, nsn, v, kinet, kini, nin, admsr, irtlm, subtria, xx, yy, zz, lbound, ibound, nnx, nny, nnz, vx1, vx2, vx3, vx4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, nodnx_sms, nsms, index, penm, lbm, lcm, pene, lb, lc, gapn_m, gapnm, gap_s, gaps, igap, gap_s_l, gap_m_l, gapmxl, intfric, ipartfrics, ipartfricsi, ipartfricm, ipartfricmi, areas, areasi, ivis2, mvoisin, mvoisn, iorthfric, irep_fricm, dir_fricm, irep_fricmi, dir_fricmi, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, intth, temp, tempi, ieles, ielesi, ielem, ielemi, istif_msdt, dtstif, stifmsdt_s, stifmsdt_m, nrtm, parameters)
Definition i25cor3.F:793
frictionparts_model_ortho
subroutine frictionparts_model_ortho(intfric, jlt, ipartfricsi, ipartfricmi, adparts_fric, nset, tabcoupleparts_fric, npartfric, tabparts_fric, tabcoef_fric, fric, viscf, frot_p, fric_coefs, fricc, viscffric, nty, mfrot, iorthfric, fric_coefs2, fricc2, viscffric2, ifricorth, nforth, nfisot, indexorth, indexisot, jlt_tied, irep_fricmi, dir_fricmi, ix3, ix4, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, ce_loc, dir1, dir2)
Definition frictionparts_model.F:43
frictionparts_model_isot
subroutine frictionparts_model_isot(intfric, jlt, ipartfricsi, ipartfricmi, adparts_fric, nset, tabcoupleparts_fric, npartfric, tabparts_fric, tabcoef_fric, fric, viscf, frot_p, fric_coefs, fricc, viscffric, nty, mfrot, iorthfric, ifric, jlt_tied, tint, tempi, npc, tf, temp, h1, h2, h3, h4, ix1, ix2, ix3, ix4, iform)
Definition frictionparts_model.F:350
i25ass3
subroutine i25ass3(jlt, nsvg, itab, ce_loc, jtask, nin, noint, intply, a, stif, stifn, niskyfi, fskyi, isky, n1, n2, n3, h1, h2, h3, h4, ix1, ix2, ix3, ix4, intth, fthe, ftheskyi, phi, phi1, phi2, phi3, phi4, fni, msegtyp, apinch, stifpinch, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, iform, condint, condn, condnskyi, nodadt_therm)
Definition i25ass3.F:46
i25dst3_3
subroutine i25dst3_3(jlt, cand_n, cand_e, cn_loc, ce_loc, irtlm, xx, yy, zz, gap_nm, xi, yi, zi, gaps, gapmxl, isharp, nnx, nny, nnz, n1, n2, n3, h1, h2, h3, h4, nin, nsn, ix1, ix2, ix3, ix4, nsvg, stif, inacti, kini, itab, lb, lc, penmin, eps, pene, pene_old, subtria, gapv, ivis2, if_adh, ifadhi, base_adh, mvoisn, ibound, vtx_bisector, dist, time)
Definition i25dst3_3.F:42
i25dst3e
subroutine i25dst3e(jlt, cand_s, cand_m, h1s, h2s, h1m, h2m, nx, ny, nz, stif, n1, n2, m1, m2, jlt_new, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, vxs1, vxs2, vys1, vys2, vzs1, vzs2, vxm1, vxm2, vym1, vym2, vzm1, vzm2, ms1, ms2, mm1, mm2, iedge, nsms, index, intfric, ipartfricsi, ipartfricmi, gapve, ex, ey, ez, fx, fy, fz, ledge, irect, cand_p, iam, jam, ibm, jbm, ias, jas, ibs, jbs, itab, edge_id, dgaploadpmax)
Definition i25dst3e.F:44
i25for3
subroutine i25for3(output, jlt, a, v, ibcc, icodt, fsav, ms, visc, viscf, noint, stfn, itab, cn_loc, stiglo, stifn, stif, inacti, index, n1, n2, n3, h1, h2, h3, h4, fcont, pene, nrtm, ix1, ix2, ix3, ix4, nsvg, ivis2, neltst, ityptst, dt2t, kinet, newfront, isecin, nstrf, secfcum, x, irect, ce_loc, mfrot, ifq, secnd_fr, alpha0, ibag, icontact, irtlm, viscn, vxi, vyi, vzi, msi, kini, nin, nisub, lisub, addsubs, addsubm, lisubs, lisubm, inflg_subs, inflg_subm, fsavsub, ilagm, icurv, fncont, ftcont, nsn, xx, yy, zz, xi, yi, zi, anglmi, padm, iadm, rcurvi, rcontact, acontact, pcontact, mskyi_sms, iskyi_sms, nsms, cand_n_n, pene_old, stif_old, mbinflg, ilev, igsti, kmin, intply, nm1, nm2, nm3, msegtyp, jtask, isensint, fsavparit, h3d_data, fricc, viscffric, fric_coefs, gapv, viscfluid, sigmaxadh, viscadhfact, if_adh, areas, base_adh, iorthfric, fric_coefs2, fricc2, viscffric2, nforth, nfisot, indexorth, indexisot, dir1, dir2, apinch, stifpinch, fni, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, intth, drad, fheats, fheatm, qfric, efrict, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, typsub, ncfit, ninloadp, dgaploadint, s_loadpinter, dist, dgaploadpmax, interefric, intcarea, parameters)
Definition i25for3.F:73
i25for3_e2s
subroutine i25for3_e2s(jlt, a, v, ibc, icodt, fsav, gap, fric, ms, visc, viscf, noint, itab, cs_loc, cm_loc, stiglo, stifn, stif, fskyi, isky, fcont, dt2t, nrtm, msegtyp, hs1, hs2, hm1, hm2, n1, n2, m1, m2, ivis2, neltst, ityptst, nx, ny, nz, gapve, inacti, index, cand_p, niskyfie, newfront, isecin, nstrf, secfcum, viscn, nedge, ms1, ms2, mm1, mm2, vxs1, vys1, vzs1, vxs2, vys2, vzs2, vxm1, vym1, vzm1, vxm2, vym2, vzm2, nin, nisub, lisub, addsube, addsubm, lisube, lisubm, inflg_sube, inflg_subm, fsavsub, mskyi_sms, iskyi_sms, nsms, jtask, isensint, fsavparit, nft, h3d_data, indx1, indx2, ilev, mbinflg, edge_id, nedge_rem, fricc, ifq, cand_fx, cand_fy, cand_fz, ifpen, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, typsub, startt, ninloadp, dgaploadint, s_loadpinter)
Definition i25for3_e2s.F:61
i25for3e
subroutine i25for3e(jlt, a, v, ibc, icodt, fsav, gap, fric, ms, visc, viscf, noint, itab, cs_loc, cm_loc, stiglo, stifn, stif, fskyi, isky, fcont, dt2t, ibm, hs1, hs2, hm1, hm2, n1, n2, m1, m2, ivis2, neltst, ityptst, nx, ny, nz, gapve, inacti, index, cand_p, niskyfie, newfront, isecin, nstrf, secfcum, viscn, nedge, ms1, ms2, mm1, mm2, vxs1, vys1, vzs1, vxs2, vys2, vzs2, vxm1, vym1, vzm1, vxm2, vym2, vzm2, nin, nisub, lisub, addsube, lisube, inflg_sube, fsavsub, mskyi_sms, iskyi_sms, nsms, jtask, isensint, fsavparit, nft, h3d_data, ilev, ebinflg, edge_id, fricc, ifq, cand_fx, cand_fy, cand_fz, ifpen, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, typsub, startt, ninloadp, dgaploadint, s_loadpinter)
Definition i25for3e.F:61
i25cdcor3_e2s
subroutine i25cdcor3_e2s(jlt, index, cand_e, cand_n, cand_e_n, cand_n_n)
Definition i25mainf.F:1197
i25cdcor3
subroutine i25cdcor3(jlt, index, cand_e, cand_n, cand_e_n, cand_n_n)
Definition i25mainf.F:1170
i25keepf
subroutine i25keepf(i_stok, index, cand_n, cand_e, nin, nsn, nsnr, inacti, mseglo, irtlm, penm, pene_old, jtask, itab, nsv, secnd_fr, time_s, stif_old)
Definition i25slid.F:628
i25therm
subroutine i25therm(jlt, kthe, tempi, areas, ielesi, ielemi, gapv, ifunctk, xthe, fni, npc, tf, frad, drad, efrict, fheats, fheatm, condint, iform, temp, h1, h2, h3, h4, fcond, dcond, tint, xi, yi, zi, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, ix1, ix2, ix3, ix4, phi, phi1, phi2, phi3, phi4, pm, nsv, itab, theaccfact)
Definition i25therm.F:41
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:311
message_mod
Definition message_mod.F:1257
tri25ebox::ledge_fie
type(int_pointer2), dimension(:), allocatable ledge_fie
Definition tri25ebox.F:90
tri7box::stif_oldfi
type(real_pointer2), dimension(:), allocatable stif_oldfi
Definition tri7box.F:545
tri7box::secnd_frfi
type(real_pointer2), dimension(:), allocatable secnd_frfi
Definition tri7box.F:543
tri7box::time_sfi
type(real_pointer), dimension(:), allocatable time_sfi
Definition tri7box.F:542
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
tri7box::pene_oldfi
type(real_pointer2), dimension(:), allocatable pene_oldfi
Definition tri7box.F:544
tri7box::if_adhfi
type(int_pointer), dimension(:), allocatable if_adhfi
Definition tri7box.F:440
sum_6_float_sens
subroutine sum_6_float_sens(f, a, b, c, jft, jlt, f6, d, e, g, isensint)
Definition parit.F:540
i25cor3_e2s
subroutine i25cor3_e2s(jlt, ledge, irect, x, cand_s, cand_m, ex, ey, ez, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, n1, n2, m1, m2, nrts, gape, gapve, fx, fy, fz, iedge, admsr, lbound, edg_bisector, vtx_bisector, itab)
Definition i25cor3_e2s.F:40
i25cor3e
subroutine i25cor3e(jlt, ledge, irect, x, cand_s, cand_m, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, ex, ey, ez, fx, fy, fz, n1, n2, m1, m2, nedge, gape, gapve, iedge, admsr, lbound, edg_bisector, vtx_bisector, itab, igap0, igap, gap_e_l)
Definition i25cor3e.F:42
i25dst3_e2s
subroutine i25dst3_e2s(jlt, iedge, cand_s, cand_m, n1, n2, m1, m2, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, gapve, pene, ex, ey, ez, fx, fy, fz, ledge, irect, x, itab, e2s_nod_normal, admsr)
Definition i25dst3_e2s.F:37
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