51 1 IPARI ,INTBUF_TAB ,X ,A ,
52 2 ICODT ,FSAV ,V ,MS ,ITAB ,
53 3 STIFN ,FSKYI ,ISKY ,FCONT ,NIN ,
54 4 LINDMAX ,JTASK ,NB_JLT ,NB_JLT_NEW,NB_STOK_N,
55 5 NSTRF ,SECFCUM ,ICONTACT ,VISCN ,NUM_IMP ,
56 6 NS_IMP ,NE_IMP ,IND_IMP ,NRTMDIM ,FNCONT ,
57 7 FTCONT ,RCONTACT ,ACONTACT ,PCONTACT,INTSTAMP,
58 8 WEIGHT ,TEMP ,FTHE ,FTHESKYI,MSKYI_SMS,
59 9 ISKYI_SMS ,NODNX_SMS ,NODGLOB,NPC ,TF ,
60 A QFRICINT,NCONT ,INDEXCONT ,TAGCONT,CONDN ,
61 B CONDNSKYI,DT2T ,NELTST ,ITYPTST ,KINET ,
62 C FBSAV6 ,ISENSINT,DIMFB ,NISKYFI ,H3D_DATA ,
63 D PSKIDS ,TAGNCONT,KLOADPINTER,LOADPINTER,LOADP_HYD_INTER,
64 E DGAPLOADINT,S_LOADPINTER,INTEREFRIC ,NODADT_THERM,THEACCFACT,
80#include "implicit_f.inc"
96#include "timeri_c.inc"
102 type(output_),
intent(inout) :: output
103 TYPE(TIMER_),
INTENT(INOUT) :: TIMERS
104 INTEGER NELTST, ITYPTST, NIN, NSTRF(*), NRTMDIM
105 INTEGER IPARI(NPARI,NINTER), ICODT(*),ICONTACT(*),
106 . ITAB(*), ISKY(*), ISKYI_SMS(*), NODNX_SMS(*),
107 . NODGLOB(*), NPC(*),INDEXCONT(*),
108 . TAGCONT(*),KINET(*),
109 . TAGNCONT(NLOADP_HYD_INTER,NUMNOD)
110 INTEGER NB_JLT,NB_JLT_NEW,NB_STOK_N,JTASK,
111 . LINDMAX, NCONT,NISKYFI
112 INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),IND_IMP(*), WEIGHT(*),
114 INTEGER ,
INTENT(IN) :: S_LOADPINTER
115 INTEGER ,
INTENT(IN) :: KLOADPINTER(NINTER+1)
116 INTEGER ,
INTENT(IN) :: LOADPINTER(S_LOADPINTER)
117 INTEGER ,
INTENT(IN) :: LOADP_HYD_INTER()
118 INTEGER ,
INTENT(IN) :: INTEREFRIC
119 INTEGER ,
INTENT(IN) :: NODADT_THERM
121 my_real ,
intent(in) :: theaccfact
122 my_real ,
INTENT(IN) :: dgaploadint(s_loadpinter)
124 . x(*), a(3,*), fsav(*), v(3,*),
125 . ms(*),stifn(*),fskyi(lskyi,4), fcont(3,*),
126 . secfcum(7,numnod,nsect), viscn(*),
127 . fncont(3,*), ftcont(3,*), rcontact(*), acontact(*),
128 . pcontact(*), temp(*), fthe(*), ftheskyi(lskyi), mskyi_sms(*),
129 . tf(*), qfricint(*),condn(*),condnskyi(lskyi), pskids(*), dt2t
130 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
132 TYPE(intbuf_struct_) INTBUF_TAB
134 TYPE(intbuf_fric_struct_),
TARGET,
DIMENSION(NINTERFRIC) :: INTBUF_FRIC_TAB
138 INTEGER I, , JLT , NFT, J,
139 . IBC, , ISECIN, IBAG, IADM,
140 . IGAP, INACTI, IFQ, MFROT, IGSTI, NISUB,
141 . NB_LOC, I_STOK_LOC,DEBUT,
142 . INTTH,IFORM, MSTR, ILEV, IKTHE, IROT, H,
143 . ,INVN,IFTLIM, IERROR, NINSKID,INTFRIC,
144 . NSETPRTS ,NPARTFRIC,JJ,IORTHFRIC,NTY
145 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
147 . cand_n_n(mvsiz), cand_e_n(mvsiz),
149 INTEGER,
DIMENSION(:),
ALLOCATABLE :: INDEX2
153 . startt, fric, gap, stopt,
154 . visc,stiglo,gapmin,viscf,
155 . kmin, kmax, gapmax, kthe, xthe, tint, dti ,pmaxskid
159 . lb(mvsiz), lc(mvsiz),
160 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
161 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
162 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
163 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
164 . nx(mvsiz), ny(mvsiz), nz(mvsiz), pene(mvsiz),
165 . gapv(mvsiz),vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz),
166 . gap0(mvsiz), area0(mvsiz), tempi(mvsiz), phi(mvsiz),
167 . mxi(mvsiz), myi(mvsiz), mzi(mvsiz),
stri(mvsiz),
168 . asi(mvsiz), bsi(mvsiz),dist(mvsiz),
169 . xp(mvsiz), yp(mvsiz), zp(mvsiz), kt(mvsiz), c(mvsiz),
170 . penrad(mvsiz), tempm(mvsiz),efrict(mvsiz),condint(mvsiz),
171 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
172 . phi1(mvsiz),phi2(mvsiz),phi3(mvsiz),phi4(mvsiz),pratio(mvsiz),
175 . rcurvi(mvsiz), anglmi(mvsiz), anglt, padm
176 INTEGER NRADM, ITRIA(MVSIZ)
179 . FXT(MVSIZ), FYT(MVSIZ), FZT(MVSIZ)
183INTEGER ICURV,SFSAVPARIT,IFRIC,FCOND
185 . ,
DIMENSION(:,:,:),
ALLOCATABLE :: FSAVPARIT
187 . FRIC_COEFS(MVSIZ,10),VISCFFRIC(MVSIZ),FRICC(MVSIZ)
189 INTEGER IPARTFRICSI(MVSIZ), IPARTFRICMI(MVSIZ)
191 INTEGER,
DIMENSION(:) ,
POINTER :: TABCOUPLEPARTS_FRIC
192 INTEGER,
DIMENSION(:) ,
POINTER :: TABPARTS_FRIC
193 INTEGER,
DIMENSION(:) ,
POINTER :: ADPARTS_FRIC
194 INTEGER,
DIMENSION(:) ,
POINTER :: IFRICORTH
195 my_real,
DIMENSION(:) ,
POINTER :: TABCOEF_FRIC
197 INTEGER,
TARGET,
DIMENSION(1):: TABCOUPLEPARTS_FRIC_BID
198 INTEGER,
TARGET,
DIMENSION(1):: TABPARTS_FRIC_BID
199 INTEGER,
TARGET,
DIMENSION(1):: ADPARTS_FRIC_BID
200 INTEGER,
TARGET,
DIMENSION(1):: IFRICORTH_BID
201 my_real,
TARGET,
DIMENSION(1):: tabcoef_fric_bid
203 CALL my_alloc(index2,lindmax)
208 IF(ipari(33,nin)==1)
RETURN
223 padm =intbuf_tab%VARIABLES(24)
224 anglt=intbuf_tab%VARIABLES(25)
226 intth = ipari(47,nin)
227 ikthe = ipari(42,nin)
228 iform_the = ipari(48,nin)
229 kthe = intbuf_tab%VARIABLES(20)
230 xthe = intbuf_tab%VARIABLES(30)
231 tint = intbuf_tab%VARIABLES(21)
232 frad = intbuf_tab%VARIABLES(31)
233 drad = intbuf_tab%VARIABLES(32)
234 fcond = ipari(53,nin)
235 dcond = intbuf_tab%VARIABLES(36)
239 stiglo=-intbuf_tab%STFAC(1)
240 startt=intbuf_tab%VARIABLES(3)
241 stopt =intbuf_tab%VARIABLES(11)
245 fric =intbuf_tab%VARIABLES(1)
246 gap =intbuf_tab%VARIABLES(2)
247 gapmin=intbuf_tab%VARIABLES(13)
248 visc =intbuf_tab%VARIABLES(14)
250 xfric =intbuf_tab%VARIABLES(34)
252 pmax =intbuf_tab%VARIABLES(15)
254 gapmax=intbuf_tab%VARIABLES(16)
255 kmin =intbuf_tab%VARIABLES(17)
256 kmax =intbuf_tab%VARIABLES(18)
258 fheat =intbuf_tab%VARIABLES(33)
262 iftlim =ipari(52,nin)
271 xg(1:3) =intstamp%XG(1:3)
272 rot(1:9)=intstamp%ROT(1:9)
275 IF(h3d_data%N_SCAL_SKID > 0)
THEN
276 ninskid = h3d_data%N_SKID_INTER(nin)
278 pmaxskid=intbuf_tab%VARIABLES(35)
281 intfric=ipari(72,nin)
284 IF(intfric /= 0)
THEN
285 tabcoupleparts_fric => intbuf_fric_tab(intfric)%TABCOUPLEPARTS_FRIC
286 tabcoef_fric => intbuf_fric_tab(intfric)%TABCOEF_FRIC
287 tabparts_fric => intbuf_fric_tab(intfric)%TABPARTS_FRIC
288 adparts_fric => intbuf_fric_tab(intfric)%ADPARTS_FRIC
289 nsetprts = intbuf_fric_tab(intfric)%NSETPRTS
290 npartfric = intbuf_fric_tab(intfric)%S_TABPARTS_FRIC
292 tabcoupleparts_fric => tabcoupleparts_fric_bid
293 tabparts_fric => tabparts_fric_bid
294 tabcoef_fric => tabcoef_fric_bid
295 adparts_fric => adparts_fric_bid
296 ifricorth => ifricorth_bid
302 i_stok = intbuf_tab%I_STOK(1)
306 nb_loc = i_stok / nthread
307 IF (jtask==nthread)
THEN
308 i_stok_loc = i_stok-nb_loc*(nthread-1)
312 debut = (jtask-1)*nb_loc
321 DO i = debut+1, debut+i_stok_loc
322 j=intbuf_tab%CAND_N(i)
324 IF(abs(intbuf_tab%IRTLM(1+2*(j-1)))==intbuf_tab%CAND_E(i))
THEN
335 IF(isensint(i)/=0)
THEN
336 sfsavparit = sfsavparit + 1
339 IF (sfsavparit /= 0)
THEN
340 ALLOCATE(fsavparit(nisub+1,11,i_stok),stat=ierror)
342 CALL ancmsg(msgid=19,anmode=aninfo,
343 . c1=
'(/INTER/TYPE21)')
349 fsavparit(h,i,j) = zero
354 ALLOCATE(fsavparit(0,0,0),stat=ierror)
356 CALL ancmsg(msgid=19,anmode=aninfo,
357 . c1=
'(/INTER/TYPE21)')
363 IF (debug(3)>=1)
THEN
364 nb_jlt = nb_jlt + i_stok_loc
365 nb_stok_n = nb_stok_n + i_stok
368 DO nft = 0 , i_stok - 1 , nvsiz
369 jlt =
min( nvsiz, i_stok - nft )
372 1 jlt,index2(nft+1),intbuf_tab%CAND_E,intbuf_tab%CAND_N,
376 1 jlt ,nin ,x ,intbuf_tab%IRECTM,nsn ,
377 2 intbuf_tab%NSV,cand_e_n ,cand_n_n ,intbuf_tab%STF,
379 3 intbuf_tab%XM0,intbuf_tab%NOD_NORMAL,intbuf_tab%IRTLM,intbuf_tab%CSTS,
381 4 ms ,v ,xi ,yi ,zi ,
382 5 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
383 6 igsti ,stif ,kmin ,kmax ,igap ,
384 7 gap ,intbuf_tab%GAP_S,gapv ,gapmax ,gapmin ,
385 8 nx ,ny ,nz ,pene ,vxm ,
386 9 vym ,vzm ,vxi ,vyi ,vzi ,
387 a msi ,itria ,lb ,lc ,iadm ,
388 b intbuf_tab%RCURV,intbuf_tab%ANGLM,nradm ,anglt ,rcurvi,
389 c anglmi ,fxt ,fyt ,fzt ,intbuf_tab%FTSAVX,
390 d intbuf_tab%FTSAVY,intbuf_tab%FTSAVZ ,intbuf_tab%GAP_S(1+nsn),
391 . intbuf_tab%AREAS,gap0 ,
392 e area0 ,intth ,temp ,tempi ,irot ,
393 f xg ,rot ,intbuf_tab%AS,intbuf_tab%BS,asi ,
394 g bsi ,xp ,yp ,zp ,nodnx_sms ,
395 h nsms ,mstr ,intbuf_tab%PENIS,intbuf_tab%IFPEN,ilev,
396 i x1 ,y1 ,z1 ,x2 ,y2 ,
397 j z2 ,x3 ,y3 ,z3 ,x4 ,
398 k y4 ,z4 ,drad ,penrad ,tint ,
399 l tempm ,iform_the ,h1 ,h2 ,h3 ,
400 m h4 ,dist ,itab ,noint ,intbuf_tab%VARIABLES(23),
401 n invn , intfric,intbuf_tab%IPARTFRICS,ipartfricsi,intbuf_tab%IPARTFRICM,
402 o ipartfricmi,ipari(5,nin) )
407 IF(jtask==1)
CALL startime(timers,macro_timer_fric)
413 1 intfric ,jlt ,ipartfricsi ,ipartfricmi ,adparts_fric ,
414 2 nsetprts ,tabcoupleparts_fric,npartfric,tabparts_fric,tabcoef_fric ,
415 3 fric ,viscf ,intbuf_tab%FRIC_P,fric_coefs , fricc ,
416 4 viscffric ,nty ,mfrot ,iorthfric ,ifric ,
417 5 jj , tint ,tempi ,npc ,tf ,
418 6 temp , h1 ,h2 ,h3 ,h4 ,
419 7 ix1 , ix2 ,ix3 ,ix4 ,iform )
421 IF(jtask==1)
CALL stoptime(timers,macro_timer_fric)
423 IF (imonm > 0 .AND. jtask == 1)
CALL startime(timers,20)
427 . nb_jlt_new = nb_jlt_new + jlt
430 1 jlt ,nin ,noint ,ibc ,icodt ,
431 2 fsav ,gap ,stiglo ,visc ,inacti ,
432 3 mfrot ,ifq ,ibag ,iadm ,ipari(39,nin) ,
433 4 stif ,gapv ,itab ,intbuf_tab%PENIS,intbuf_tab%ALPHA0,
434 5 intbuf_tab%IFPEN ,icontact ,rcontact,acontact ,pcontact,
435 6 nsvg ,x1 ,y1 ,z1 ,x2 ,
436 7 y2 ,z2 ,x3 ,y3 ,z3 ,
437 8 x4 ,y4 ,z4 ,xi ,yi ,
438 9 zi ,vxi ,vyi ,vzi ,msi ,
439 a vxm ,vym ,vzm ,nx ,ny ,
440 b nz ,pene ,fxt ,fyt ,fzt ,
441 c fxn ,fyn ,fzn ,rcurvi ,anglmi ,
442 d padm ,cand_n_n,weight ,igap ,gap0 ,
443 e area0 ,pmax ,irot ,xg ,mxi ,
444 g myi ,mzi ,
stri ,wxm ,wym ,
445 h wzm ,xp ,yp ,zp ,kt ,
446 i c ,ilev ,fni ,intth ,fheat ,
447 j efrict ,qfricint(nin),ifric ,xfric ,tempi ,
448 k tempm ,npc ,tf ,ix1 ,ix2 ,
449 l ix3 ,ix4 ,dt2t ,neltst ,ityptst ,
450 m kinet ,nisub ,isensint ,fsavparit,nft ,
451 n iftlim ,ninskid ,pratio ,pmaxskid ,interefric ,
452 o efric_l ,fricc ,fric_coefs)
455 CALL i21therm(jlt ,xi ,yi ,zi ,kthe ,
456 2 tempi ,phi ,area0 ,noint ,asi ,
457 3 bsi ,gapv ,pene ,ikthe ,xthe ,
458 4 fni ,npc ,tf ,frad ,drad ,
459 5 penrad ,tempm ,fheat ,efrict,condint,
460 6 iform_the,h1 ,h2 ,h3 ,h4 ,
461 7 phi1 ,phi2 ,phi3 ,phi4 ,x1 ,
462 8 y1 ,z1 ,x2 ,y2 ,z2 ,
463 9 x3 ,y3 ,z3 ,x4 ,y4 ,
464 a z4 ,itab ,nsvg ,intbuf_tab%MSR_L,ix1 ,
465 b ix2 ,ix3 ,ix4 ,temp ,fcond ,
469 IF(idtmins==2.OR.idtmins_int/=0)
THEN
471 CALL i21sms2(jlt ,mstr ,nsvg ,nin ,noint ,
472 2 mskyi_sms ,iskyi_sms,nsms ,kt ,c ,
481 IF(idtmins_int/=0)
THEN
485 CALL i21ass3(output, jlt ,a ,nin ,noint ,fxn ,
486 2 fyn ,fzn ,fxt ,fyt ,fzt ,
487 3 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
488 4 fcont ,fncont ,ftcont ,lb ,lc ,
489 5 itria ,stifn ,stif ,fskyi ,isky ,
490 6 isecin ,nstrf ,secfcum ,intbuf_tab%FTSAVX,
492 7 intbuf_tab%FTSAVZ ,cand_n_n ,intstamp,weight ,
494 8 intth ,phi ,fthe ,ftheskyi ,mxi ,
495 9 myi ,mzi ,
stri ,nodglob ,ncont ,
496 a indexcont,tagcont ,condn ,condint ,condnskyi,
497 b iform_the, phi1 ,phi2 ,phi3 ,phi4 ,
498 c h1 ,h2 ,h3 ,h4 ,niskyfi ,
499 d intbuf_tab%MSR_L ,itab ,h3d_data ,ninskid ,
500 e pratio ,h3d_data%N_SCAL_SKID,pskids ,ipari(95,nin),
501 f tagncont ,kloadpinter,loadpinter ,loadp_hyd_inter,
502 g dgaploadint,dist,gapv,s_loadpinter ,efric_l ,
503 h fheat ,efrict ,interefric ,
506 IF (imonm > 0 .AND. jtask == 1)
CALL stoptime(timers,20)
511 IF (sfsavparit /= 0)
THEN
513 . fbsav6, 12, 6, dimfb, isensint )
515 IF (
ALLOCATED(fsavparit))
DEALLOCATE (fsavparit)
subroutine i21cor3(jlt, nin, x, irect, nsn, nsv, cand_e, cand_n, stf, stfn, xm0, nod_normal, irtlm, csts, msr, ms, v, xi, yi, zi, ix1, ix2, ix3, ix4, nsvg, igsti, stif, kmin, kmax, igap, gap, gap_s, gapv, gapmax, gapmin, nx, ny, nz, pene, vxm, vym, vzm, vxi, vyi, vzi, msi, itria, lb, lc, iadm, rcurv, anglm, nradm, anglt, rcurvi, anglmi, fxt, fyt, fzt, ftxsav, ftysav, ftzsav, gap_s0, area_s0, gap0, area0, intth, temp, tempi, irot, xg, rot, as, bs, asi, bsi, xp, yp, zp, nodnx_sms, nsms, mstr, peni, ifpen, ilev, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, drad, penrad, tint, tempm, iform, h1, h2, h3, h4, dist, itab, noint, depth, invn, intfric, ipartfrics, ipartfricsi, ipartfricm, ipartfricmi, nrtm)
subroutine i21for3(jlt, nin, noint, ibcc, icodt, fsav, gap, stiglo, visc, inacti, mfrot, ifq, ibag, iadm, icurv, stif, gapv, itab, peni, alpha0, ifpen, icontact, rcontact, acontact, pcontact, nsvg, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, xi, yi, zi, vxi, vyi, vzi, msi, vxm, vym, vzm, nx, ny, nz, pene, fxt, fyt, fzt, fxn, fyn, fzn, rcurvi, anglmi, padm, cand_n_n, weight, igap, gap0, area0, pmax, irot, xg, mxi, myi, mzi, stri, wxm, wym, wzm, xp, yp, zp, kt, c, ilev, fni, intth, fheat, efrict, qfric, ifric, xfric, tempi, tempm, npc, tf, ix1, ix2, ix3, ix4, dt2t, neltst, ityptst, kinet, nisub, isensint, fsavparit, nft, iftlim, pskidflag, pratio, pmaxskid, interefric, efric_l, fricc, fric_coefs)