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