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 (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 1167 of file i25mainf.F.

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

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

◆ i25mainf()

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