61
62
63
64 USE timer_mod
65 USE intbufdef_mod
67 USE intbuf_fric_mod
69 USE my_alloc_mod
70
71
72
73#include "implicit_f.inc"
74
75
76
77#include "mvsiz_p.inc"
78
79
80
81#include "com04_c.inc"
82#include "com08_c.inc"
83#include "param_c.inc"
84#include "warn_c.inc"
85#include "task_c.inc"
86#include "parit_c.inc"
87#include "impl1_c.inc"
88#include "timeri_c.inc"
89#include "macro.inc"
90
91
92
93 TYPE(TIMER_), INTENT(INOUT) :: TIMERS
94 INTEGER ,INTENT(IN) :: NODADT_THERM
95 INTEGER NELTST,,NIN,NEWFRONT,NSTRF(*)
96 INTEGER IPARI(*), ICODT(*),
97 . ITAB(*), ISKY(*),ICONTACT(*),TAGNCONT(,NUMNOD)
98 INTEGER , INTENT(IN) :: S_LOADPINTER
99 INTEGER , INTENT(IN) :: KLOADPINTER(NINTER+1),LOADPINTER(S_LOADPINTER),
100 . LOADP_HYD_INTER(NLOADP_HYD)
101
102 INTEGER NB_JLT,NB_JLT_NEW,NB_STOK_N,JTASK,
103 . NISKYFI, LINDMAX,ITASK
104 INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),
105 . ISKYI_SMS(*), (*),NPC(*), (*),DIMFB
106
107 my_real ,
INTENT(IN) :: dgaploadint(s_loadpinter)
109 . x(*), a(3,*), fsav(*), v(3,*),
110 . ms(*), stifn(*), fskyi(lskyi,nfskyi), fcont(3,*),
111 . secfcum(7,numnod,nsect), viscn(*), mskyi_sms(*),
112 . temp(*),fthe(*),ftheskyi(*),tf(*),condn(*),condnskyi(*),
113 . pm(npropm,*),fsavsub(*)
114
115 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
116
117 TYPE(INTBUF_STRUCT_) INTBUF_TAB
118 TYPE(H3D_DATABASE) :: H3D_DATA
119 TYPE(INTBUF_FRIC_STRUCT_), TARGET, DIMENSION(NINTERFRIC) :: INTBUF_FRIC_TAB
120
121
122
123 INTEGER KD(50), JD(50), JFI, KFI,
124 . I, J, H, IBC, NOINT, ISECIN, I_STOK, NSEG,
125 . JLT , NFT, JLT_NEW, IGAP, ,
126 . NB_LOC, I_STOK_LOC,DEBUT,I3N, IGSTI,IFORM,INTTH,IKTHE,
127 . IFORMTH,SFSAVPARIT,NISUB,INTFRIC,NSETPRTS,NPARTFRIC,MFROT,IFQ,
128 . IERROR,IORTHFRIC,IFRIC,JJ,NINLOADP
129 INTEGER N1(MVSIZ), N2(MVSIZ), M1(MVSIZ), M2(MVSIZ),
130 . NSVG(MVSIZ), (MVSIZ), CM_LOC(MVSIZ),
131 . NSMS(MVSIZ)
132 INTEGER I_STOK_NEW,CAND_S(MVSIZ),CAND_M(MVSIZ),
133 . INDEXM1(LINDMAX),IELECI(MVSIZ),IELESI(MVSIZ), IPARTFRICSI(MVSIZ),
134 . IPARTFRICMI(MVSIZ)
135 INTEGER,DIMENSION(:), ALLOCATABLE :: INDEX2
136
138 . startt, fric, gap, stopt,
139 . visc,viscf,stiglo, gapmin, kmin, kmax,dtmini,
140 . tint,xthe,kthe,frad,drad,dgapload
141
142
144 . nx(mvsiz),ny(mvsiz),nz(mvsiz),
145 . hs1(mvsiz), hs2(mvsiz), hm1(mvsiz), hm2(mvsiz),
146 . stif(mvsiz),gapv(mvsiz),
147 . xxs1(mvsiz), xxs2(mvsiz), xys1(mvsiz), xys2(mvsiz),
148 . xzs1(mvsiz), xzs2(mvsiz), xxm1(mvsiz), xxm2(mvsiz),
149 . xym1(mvsiz), xym2(mvsiz), xzm1(mvsiz), xzm2(mvsiz),
150 . vxs1(mvsiz), vxs2(mvsiz), vys1(mvsiz), vys2(mvsiz),
151 . vzs1(mvsiz), vzs2(mvsiz), vxm1(mvsiz), vxm2(mvsiz),
152 . vym1(mvsiz), vym2(mvsiz), vzm1(mvsiz), vzm2(mvsiz),
153 . ms1(mvsiz), ms2(mvsiz), mm1(mvsiz), mm2(mvsiz),
154 . fni(mvsiz), tempi1(mvsiz),tempi2(mvsiz),tempm1(mvsiz),
155 . tempm2(mvsiz),phis1(mvsiz),phis2(mvsiz),phim1(mvsiz),
156 . phim2(mvsiz),areac(mvsiz), condints1(mvsiz),
157 . condints2(mvsiz),condintm1(mvsiz),condintm2(mvsiz),
158 . penrad(mvsiz),fx1(mvsiz), fx2(mvsiz),
159 . fx3(mvsiz), fx4(mvsiz),fy1(mvsiz), fy2(mvsiz),
160 . fy3(mvsiz), fy4(mvsiz),fz1(mvsiz), fz2(mvsiz),
161 . fz3(mvsiz), fz4(mvsiz),k1(mvsiz) , k2(mvsiz) ,
162 . k3(mvsiz) , k4(mvsiz) ,c1(mvsiz) , c2(mvsiz) ,
163 . c3(mvsiz) , c4(mvsiz)
164 my_real,
DIMENSION(:,:,:),
ALLOCATABLE :: fsavparit
166 . xfiltr_fric,fric_coefs(mvsiz,10),viscffric(mvsiz),fricc(mvsiz)
167 INTEGER, DIMENSION(:) ,POINTER :: TABCOUPLEPARTS_FRIC
168 INTEGER, DIMENSION(:) ,POINTER :: TABPARTS_FRIC
169 INTEGER, DIMENSION(:) ,POINTER ::
170 my_real,
DIMENSION(:) ,
POINTER :: tabcoef_fric
171
172 INTEGER,TARGET, DIMENSION(1):: TABCOUPLEPARTS_FRIC_BID
173 INTEGER,TARGET, DIMENSION(1):: TABPARTS_FRIC_BID
174 INTEGER,TARGET, DIMENSION(1):: ADPARTS_FRIC_BID
175 my_real,
TARGET,
DIMENSION(1):: tabcoef_fric_bid
176 INTEGER :: NRTS, NTY
177
178 CALL my_alloc(index2,lindmax)
179
180
181
182
183
184
185
186
187
188 nrts =ipari(3)
189 nty =ipari(7)
190 ibc =ipari(11)
191 ivis2 =ipari(14)
192 noint =ipari(15)
193 igap =ipari(21)
194 isecin=ipari(28)
195 iform =ipari(30)
196 igsti =ipari(34)
197 nisub =ipari(36)
198
199 stiglo=-intbuf_tab%STFAC(1)
200 startt=intbuf_tab%VARIABLES(3)
201 stopt =intbuf_tab%VARIABLES(11)
202 IF(startt>tt) RETURN
203 IF(tt>stopt) RETURN
204
205 fric =intbuf_tab%VARIABLES(1)
206 gap =intbuf_tab%VARIABLES(2)
207 gapmin=intbuf_tab%VARIABLES(13)
208 visc =intbuf_tab%VARIABLES(14)
209 viscf =intbuf_tab%VARIABLES(15)
210 kmin =intbuf_tab%VARIABLES(17)
211 kmax =intbuf_tab%VARIABLES(18)
212 dtmini=intbuf_tab%VARIABLES(41)
213 dgapload=intbuf_tab%VARIABLES(46)
214 num_imp = 0
215 IF (impl_s==1) THEN
216 visc =zero
217 viscf =zero
218 ENDIF
219
220 intth = ipari(47)
221 ikthe = ipari(43)
222 iformth =ipari(44)
223 kthe = intbuf_tab%VARIABLES(20)
224 xthe = intbuf_tab%VARIABLES(22)
225 tint = intbuf_tab%VARIABLES(21)
226 frad = intbuf_tab%VARIABLES(23)
227 drad = intbuf_tab%VARIABLES(24)
228 ifric = 0
229
230 intfric=ipari(72)
231 mfrot = 0
232 iorthfric = 0
233 npartfric = 0
234 xfiltr_fric = 0
235 nsetprts = 0
236 IF(intfric /= 0) THEN
237 tabcoupleparts_fric => intbuf_fric_tab(intfric)%TABCOUPLEPARTS_FRIC
238 tabcoef_fric => intbuf_fric_tab(intfric)%TABCOEF_FRIC
239 tabparts_fric => intbuf_fric_tab(intfric)%TABPARTS_FRIC
240 adparts_fric => intbuf_fric_tab(intfric)%ADPARTS_FRIC
241 xfiltr_fric = intbuf_fric_tab(intfric)%XFILTR_FRIC
242 nsetprts = intbuf_fric_tab(intfric)%NSETPRTS
243 npartfric = intbuf_fric_tab(intfric)%S_TABPARTS_FRIC
244 iorthfric = intbuf_fric_tab(intfric)%IORTHFRIC
245 ELSE
246 tabcoupleparts_fric => tabcoupleparts_fric_bid
247 tabparts_fric => tabparts_fric_bid
248 tabcoef_fric => tabcoef_fric_bid
249 adparts_fric => adparts_fric_bid
250 ENDIF
251
252 ninloadp = ipari(95) ! load pressure related to inter
253
254 i_stok = intbuf_tab%I_STOK(1)
255
256
257 nb_loc = i_stok / nthread
258 IF (jtask==nthread) THEN
259 i_stok_loc = i_stok-nb_loc*(nthread-1)
260 ELSE
261 i_stok_loc = nb_loc
262 ENDIF
263 debut = (jtask-1)*nb_loc
264 i_stok = 0
265
266 DO i = debut+1, debut+i_stok_loc
267 IF(intbuf_tab%CAND_N(i)<0) THEN
268 i_stok = i_stok + 1
269 index2(i_stok) = i
270
271 intbuf_tab%CAND_N(i) = -intbuf_tab%CAND_N(i)
272 ENDIF
273 ENDDO
274 IF (debug(3)>=1) THEN
275 nb_jlt = nb_jlt + i_stok_loc
276 nb_stok_n = nb_stok_n + i_stok
277 ENDIF
278
279 sfsavparit = 0
280 DO i=1,nisub+1
281 IF(isensint(i)/=0) THEN
282 sfsavparit = sfsavparit + 1
283 ENDIF
284 ENDDO
285 IF (sfsavparit /= 0) THEN
286 ALLOCATE(fsavparit(nisub+1,11,i_stok),stat=ierror)
287 IF(ierror/=0) THEN
288 CALL ancmsg(msgid=19,anmode=aninfo,
289 . c1='(/INTER/TYPE11)')
291 ENDIF
292 DO j=1,i_stok
293 DO i=1,11
294 DO h=1,nisub+1
295 fsavparit(h,i,j) = zero
296 ENDDO
297 ENDDO
298 ENDDO
299 ELSE
300 ALLOCATE(fsavparit(0,0,0),stat=ierror)
301 IF(ierror/=0) THEN
302 CALL ancmsg(msgid=19,anmode=aninfo,
303 . c1='(/INTER/TYPE11)')
305 ENDIF
306 ENDIF
307
308 DO nft = 0 , i_stok - 1 , nvsiz
309 jlt =
min( nvsiz, i_stok - nft )
310
312 1 jlt,index2(nft+1),intbuf_tab%CAND_E,intbuf_tab%CAND_N,cm_loc,
313 2 cs_loc)
314
316 1 jlt ,intbuf_tab%IRECTS,intbuf_tab%IRECTM,x ,v ,
317 2 cs_loc ,cm_loc ,intbuf_tab%STFS ,intbuf_tab%STFM,gapmin ,
318 3 intbuf_tab%GAP_S,intbuf_tab%GAP_M,igap ,gapv ,ms ,
319 4 stif ,xxs1 ,xxs2 ,xys1 ,xys2 ,
320 5 xzs1 ,xzs2 ,xxm1 ,xxm2 ,xym1 ,
321 6 xym2 ,xzm1 ,xzm2 ,vxs1 ,vxs2 ,
322 7 vys1 ,vys2 ,vzs1 ,vzs2 ,vxm1 ,
323 8 vxm2 ,vym1 ,vym2 ,vzm1 ,vzm2 ,
324 9 ms1 ,ms2 ,mm1 ,mm2 ,n1 ,
325 a n2 ,m1 ,m2 ,nrts ,nin ,
326 b igsti ,kmin ,kmax ,nodnx_sms ,nsms ,
327 c intbuf_tab%GAP_SL, intbuf_tab%GAP_ML,intth,temp ,tempi1 ,
328 d tempi2 ,tempm1 ,tempm2,intbuf_tab%AREAS,intbuf_tab%AREAM,
329 e areac ,ieleci ,ielesi,intbuf_tab%IELEC,intbuf_tab%IELES,
330 f iformth , itab ,intfric ,intbuf_tab%IPARTFRICS,ipartfricsi,
331 g intbuf_tab%IPARTFRICM,ipartfricmi)
332
334 1 jlt ,cs_loc ,cm_loc ,hs1 ,hs2 ,
335 2 hm1 , hm2 ,nx ,ny ,nz ,
336 3 stif ,n1 ,n2 ,m1 ,m2 ,
337 4 jlt_new ,xxs1 ,xxs2 ,xys1 ,xys2 ,
338 5 xzs1 ,xzs2 ,xxm1 ,xxm2 ,xym1 ,
339 6 xym2 ,xzm1 ,xzm2 ,vxs1 ,vxs2 ,
340 7 vys1 ,vys2 ,vzs1 ,vzs2 ,vxm1 ,
341 8 vxm2 ,vym1 ,vym2 ,vzm1 ,vzm2 ,
342 9 ms1 ,ms2 ,mm1 ,mm2 ,gapv ,
343 a nsms ,index2(nft+1),drad , intfric ,ipartfricsi,
344 b ipartfricmi,dgapload)
345
346 jlt = jlt_new
347 IF(jlt_new/=0) THEN
348 IF (imonm > 0 .AND. jtask == 1)
CALL startime(timers,20)
349 ipari(29) = 1
350 IF (debug(3)>=1)
351 . nb_jlt_new = nb_jlt_new + jlt_new
352
353
354
355
356 IF(itask==1)
CALL startime(timers,macro_timer_fric)
357 jj = 0
359 1 intfric ,jlt ,ipartfricsi ,ipartfricmi ,adparts_fric,
360 2 nsetprts ,tabcoupleparts_fric,npartfric ,tabparts_fric,tabcoef_fric,
361 3 fric ,viscf ,intbuf_tab%FRIC_P,fric_coefs , fricc ,
362 4 viscffric ,nty ,mfrot ,iorthfric , ifric ,
363 5 jj , tint ,tempi1 ,npc ,tf ,
364 6 temp , hs1 ,hs2 ,hm1 ,hm2 ,
365 7 n1 , n2 ,m1 ,m2 ,iform )
366 IF(itask==1)
CALL stoptime(timers,macro_timer_fric)
367
369 1 jlt ,fsav ,gap ,fric ,ms ,
370 2 visc ,viscf ,noint ,itab ,cs_loc ,
371 3 cm_loc ,stif ,dt2t ,hs1 ,hs2 ,
372 4 hm1 ,hm2 ,n1 ,n2 , m1 ,
373 5 m2 ,ivis2 ,neltst ,ityptst ,nx ,
374 6 ny ,nz ,gapv,intbuf_tab%PENIS,intbuf_tab%PENIM ,
375 7 ipari(22) ,newfront,nrts ,ms1 ,ms2 ,
376 8 mm1 ,mm2 ,vxs1 ,vys1 ,vzs1 ,
377 9 vxs2 ,vys2 ,vzs2 ,vxm1 ,vym1 ,
378 a vzm1 ,vxm2 ,vym2 ,vzm2 ,nin ,
379 b dtmini,iform ,intbuf_tab%FTSAVX,intbuf_tab%FTSAVY,intbuf_tab%FTSAVZ,
380 c index2(nft+1),intbuf_tab%IFPEN ,intbuf_tab%STFS,fni ,
381 e fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
382 f fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
383 g fy4 ,fz4 ,k1 ,k2 ,k3 ,
384 h k4 ,c1 ,c2 ,c3 ,c4 ,
385 i intth ,drad ,penrad ,isensint ,fsavparit ,
386 j nisub ,nft ,intbuf_tab%ADDSUBS ,intbuf_tab%ADDSUBM,
387 k intbuf_tab%LISUBS,intbuf_tab%LISUBM,intbuf_tab%LISUB,fsavsub,fricc ,
388 l viscffric ,tagncont ,kloadpinter,loadpinter,loadp_hyd_inter ,
389 m intbuf_tab%TYPSUB,intbuf_tab%INFLG_SUBS,intbuf_tab%INFLG_SUBM ,
390 . ninloadp ,dgaploadint,
391 n s_loadpinter )
392
393
394 IF( intth > 0 ) THEN
396 1 jlt ,pm ,intth ,penrad , kthe ,
397 2 tempi1 ,tempi2 ,tempm1 ,tempm2 ,phis1 ,
398 3 phis2 ,tint ,areac ,ieleci ,ielesi ,
399 4 frad ,gapv ,fni ,ikthe ,xthe ,
400 5 npc ,drad ,tf ,hs1 ,hs2 ,
401 6 hm1 ,hm2 ,condints1 ,condints2,phim1 ,
402 7 phim2 ,condintm1,condintm2 ,iformth )
403 ENDIF
404
406 1 jlt ,a ,nin ,noint ,cs_loc ,
407 2 stifn ,stif ,fskyi ,isky ,fcont ,
408 3 hs1 ,hs2 ,hm1 ,hm2 ,n1 ,
409 4 n2 ,m1 ,m2 ,niskyfi ,isecin ,
410 5 nstrf ,secfcum ,viscn ,nrts ,iskyi_sms,
411 6 nsms ,icontact ,mskyi_sms ,fx1 ,fy1 ,
412 7 fz1 ,fx2 ,fy2 ,fz2 ,fx3 ,
413 8 fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
414 9 k1 ,k2 ,k3 ,k4 ,c1 ,
415 a c2 ,c3 ,c4 ,intth ,phis1 ,
416 b phis2 ,phim1 ,phim2 ,fthe ,ftheskyi ,
417 c condints1 ,condints2 ,condintm1 ,condintm2 ,condn ,
418 d condnskyi ,jtask ,h3d_data ,nodadt_therm)
419
420 IF(impl_s==1) THEN
421 DO i = 1 ,jlt_new
422 ns_imp(i+num_imp)=cs_loc(i)
423 ne_imp(i+num_imp)=cm_loc(i)
424 ENDDO
425 num_imp=num_imp+jlt_new
426 ENDIF
427 IF (imonm > 0 .AND. jtask == 1)
CALL stoptime(timers,20)
428 ENDIF
429 ENDDO
430 IF (sfsavparit /= 0)THEN
432 . fbsav6, 12, 6, dimfb, isensint )
433 ENDIF
434 IF(ALLOCATED(fsavparit)) DEALLOCATE (fsavparit)
435 IF(ALLOCATED(index2)) DEALLOCATE (index2)
436
437
438 RETURN
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)
subroutine i11ass3(jlt, a, nin, noint, cs_loc, stifn, stif, fskyi, isky, fcont, hs1, hs2, hm1, hm2, n1, n2, m1, m2, niskyfi, isecin, nstrf, secfcum, viscn, nrts, iskyi_sms, nsms, icontact, mskyi_sms, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, k1, k2, k3, k4, c1, c2, c3, c4, intth, phis1, phis2, phim1, phim2, fthe, ftheskyi, condints1, condints2, condintm1, condintm2, condn, condnskyi, jtask, h3d_data, nodadt_therm)
subroutine i11cdcor3(jlt, index, cand_m, cand_s, cand_m_n, cand_s_n)
subroutine i11cor3(jlt, irects, irectm, x, v, cand_s, cand_m, stfs, stfm, gap, gap_s, gap_m, igap, gapv, ms, stif, 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, n1, n2, m1, m2, nrts, nin, igsti, kmin, kmax, nodnx_sms, nsms, gap_s_l, gap_m_l, intth, temp, tempi1, tempi2, tempm1, tempm2, areas, aream, areac, ieleci, ielesi, ielec, ieles, iform, itab, intfric, ipartfrics, ipartfricsi, ipartfricm, ipartfricmi)
subroutine i11for3(jlt, fsav, gap, fric, ms, visc, viscf, noint, itab, cs_loc, cm_loc, stif, dt2t, hs1, hs2, hm1, hm2, n1, n2, m1, m2, ivis2, neltst, ityptst, nx, ny, nz, gapv, penis, penim, inacti, newfront, nrts, ms1, ms2, mm1, mm2, vxs1, vys1, vzs1, vxs2, vys2, vzs2, vxm1, vym1, vzm1, vxm2, vym2, vzm2, nin, dtmini, iform, cand_fx, cand_fy, cand_fz, index, ifpen, stfs, fni, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, k1, k2, k3, k4, c1, c2, c3, c4, intth, drad, penrad, isensint, fsavparit, nisub, nft, addsubs, addsubm, lisubs, lisubm, lisub, fsavsub, fricc, viscffric, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, typsub, inflg_subs, inflg_subm, ninloadp, dgaploadint, s_loadpinter)
subroutine i11therm(jlt, pm, intth, penrad, kthe, tempi1, tempi2, tempm1, tempm2, phis1, phis2, tint, areac, ieleci, ielesi, frad, gapv, fni, ifunctk, xthe, npc, drad, tf, hs1, hs2, hm1, hm2, condints1, condints2, phim1, phim2, condintm1, condintm2, iform)
subroutine sum_6_float_sens(f, a, b, c, jft, jlt, f6, d, e, g, isensint)
subroutine i11dst3(jlt, gap, cand_s, cand_m, irects, irectm, nx, ny, nz, n1, n2, m1, m2, jlt_new, x, igap, gap_s, gap_m, gapv2, gap_s_l, gap_m_l, drad, dgapload)
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)
subroutine startime(event, itask)
subroutine stoptime(event, itask)