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(timer_),
INTENT(INOUT) :: TIMERS
103 INTEGER NELTST, ITYPTST, NIN, NSTRF(*), NRTMDIM
104 INTEGER IPARI(NPARI,NINTER), ICODT(*),ICONTACT(*),
105 . ITAB(*), ISKY(*), ISKYI_SMS(*), NODNX_SMS(*),
106 . TAGMSR_I21_SMS, NODGLOB(*), NPC(*),INDEXCONT(*),
107 . TAGCONT(*),KINET(*),
108 . TAGNCONT(NLOADP_HYD_INTER,NUMNOD)
109 INTEGER NB_JLT,NB_JLT_NEW,NB_STOK_N,JTASK,
110 . LINDMAX, NCONT,NISKYFI
111 INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),IND_IMP(*), WEIGHT(*),
113 INTEGER ,
INTENT(IN) :: S_LOADPINTER
114 INTEGER ,
INTENT(IN) :: KLOADPINTER(NINTER+1)
115 INTEGER ,
INTENT(IN) :: LOADPINTER(S_LOADPINTER)
116 INTEGER ,
INTENT(IN) :: LOADP_HYD_INTER(NLOADP_HYD)
117 INTEGER ,
INTENT(IN) :: INTEREFRIC
118 INTEGER ,
INTENT(IN) :: NODADT_THERM
120 my_real ,
intent(in) :: theaccfact
121 my_real ,
INTENT(IN) :: dgaploadint(s_loadpinter)
123 . x(*), a(3,*), fsav(*), v(3,*),
124 . ms(*),stifn(*),fskyi(lskyi,4), fcont(3,*),
125 . secfcum(7,numnod,nsect), viscn(*),
126 . fncont(3,*), ftcont(3,*), rcontact(*), acontact(*),
127 . pcontact(*), temp(*), fthe(*), ftheskyi(lskyi), mskyi_sms(*),
128 . tf(*), qfricint(*),condn(*),condnskyi(lskyi), pskids(*), dt2t
129 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
131 TYPE(intbuf_struct_) INTBUF_TAB
133 TYPE(intbuf_fric_struct_),
TARGET,
DIMENSION(NINTERFRIC) :: INTBUF_FRIC_TAB
137 INTEGER I, I_STOK, JLT_NEW, JLT , NFT, J,
138 . IBC, NOINT, NSEG, ISECIN, IBAG, IADM,
139 . IGAP, INACTI, IFQ, MFROT, IGSTI, NISUB,
140 . NB_LOC, I_STOK_LOC,DEBUT,
141 . INTTH,IFORM, NCAND, MSTR, ILEV, IKTHE, IROT, H,
142 . IFORM_THE,INVN,IFTLIM, IERROR, NINSKID,INTFRIC,
143 . NSETPRTS ,NPARTFRIC,JJ,IORTHFRIC,NTY
144 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
146 . cand_n_n(mvsiz), cand_e_n(mvsiz),
148 INTEGER,
DIMENSION(:),
ALLOCATABLE :: INDEX2
152 . startt, fric, gap, stopt,
153 . visc,stiglo,gapmin,viscf,
154 . kmin, kmax, gapmax, kthe, xthe, tint, rhoh, dti ,pmaxskid
158 . lb(mvsiz), lc(mvsiz),
159 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
160 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
161 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
162 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
163 . nx(mvsiz), ny(mvsiz), nz(mvsiz), pene(mvsiz),
164 . gapv(mvsiz),vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz),
165 . gap0(mvsiz), area0(mvsiz), tempi(mvsiz), phi(mvsiz),
166 . mxi(mvsiz), myi(mvsiz), mzi(mvsiz),
stri(mvsiz),
167 . asi(mvsiz), bsi(mvsiz),dist(mvsiz),
168 . xp(mvsiz), yp(mvsiz), zp(mvsiz), kt(mvsiz), c(mvsiz),
169 . penrad(mvsiz), tempm(mvsiz),efrict(mvsiz),condint(mvsiz),
170 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
171 . phi1(mvsiz),phi2(mvsiz),phi3(mvsiz),phi4(mvsiz),pratio(mvsiz),
174 . rcurvi(mvsiz), anglmi(mvsiz), anglt, padm
175 INTEGER NRTMFT, NRTMLT, NRADM, ITRIA(MVSIZ)
178 . FXT(MVSIZ), FYT(MVSIZ), FZT(MVSIZ),
179 . FXN(MVSIZ), FYN(MVSIZ), FZN(MVSIZ),
180 . VXM, VYM, VZM, FX, FY, FZ, STF, PMAX,
181 . XG(3), ROT(9), WXM, WYM, WZM, FRAD, DRAD, FHEAT, XFRIC,DCOND
182 INTEGER ICURV,SFSAVPARIT,IFRIC,FCOND
184 . ,
DIMENSION(:,:,:),
ALLOCATABLE :: FSAVPARIT
186 . FRIC_COEFS(MVSIZ,10),VISCFFRIC(MVSIZ),FRICC(MVSIZ)
188 INTEGER IPARTFRICSI(MVSIZ), IPARTFRICMI(MVSIZ)
190 INTEGER,
DIMENSION(:) ,
POINTER :: TABCOUPLEPARTS_FRIC
191 INTEGER,
DIMENSION(:) ,
POINTER :: TABPARTS_FRIC
192 INTEGER,
DIMENSION(:) ,
POINTER :: ADPARTS_FRIC
193 INTEGER,
DIMENSION(:) ,
POINTER :: IFRICORTH
194 my_real,
DIMENSION(:) ,
POINTER :: TABCOEF_FRIC
196 INTEGER,
TARGET,
DIMENSION(1):: TABCOUPLEPARTS_FRIC_BID
197 INTEGER,
TARGET,
DIMENSION(1):: TABPARTS_FRIC_BID
198 INTEGER,
TARGET,
DIMENSION(1):: ADPARTS_FRIC_BID
199 INTEGER,
TARGET,
DIMENSION(1):: IFRICORTH_BID
200 my_real,
TARGET,
DIMENSION(1):: tabcoef_fric_bid
202 CALL my_alloc(index2,lindmax)
207 IF(ipari(33,nin)==1)
RETURN
222 padm =intbuf_tab%VARIABLES(24)
223 anglt=intbuf_tab%VARIABLES(25)
225 intth = ipari(47,nin)
226 ikthe = ipari(42,nin)
227 iform_the = ipari(48,nin)
228 kthe = intbuf_tab%VARIABLES(20)
229 xthe = intbuf_tab%VARIABLES(30)
230 tint = intbuf_tab%VARIABLES(21)
231 frad = intbuf_tab%VARIABLES(31)
232 drad = intbuf_tab%VARIABLES(32)
233 fcond = ipari(53,nin)
234 dcond = intbuf_tab%VARIABLES(36)
238 stiglo=-intbuf_tab%STFAC(1)
239 startt=intbuf_tab%VARIABLES(3)
240 stopt =intbuf_tab%VARIABLES(11)
244 fric =intbuf_tab%VARIABLES(1)
245 gap =intbuf_tab%VARIABLES(2)
246 gapmin=intbuf_tab%VARIABLES(13)
247 visc =intbuf_tab%VARIABLES(14)
249 xfric =intbuf_tab%VARIABLES(34)
251 pmax =intbuf_tab%VARIABLES(15)
253 gapmax=intbuf_tab%VARIABLES(16)
254 kmin =intbuf_tab%VARIABLES(17)
255 kmax =intbuf_tab%VARIABLES(18)
257 fheat =intbuf_tab%VARIABLES(33)
261 iftlim =ipari(52,nin)
270 xg(1:3) =intstamp%XG(1:3)
271 rot(1:9)=intstamp%ROT(1:9)
274 IF(h3d_data%N_SCAL_SKID > 0)
THEN
275 ninskid = h3d_data%N_SKID_INTER(nin)
277 pmaxskid=intbuf_tab%VARIABLES(35)
280 intfric=ipari(72,nin)
283 IF(intfric /= 0)
THEN
284 tabcoupleparts_fric => intbuf_fric_tab(intfric)%TABCOUPLEPARTS_FRIC
285 tabcoef_fric => intbuf_fric_tab(intfric)%TABCOEF_FRIC
286 tabparts_fric => intbuf_fric_tab(intfric)%TABPARTS_FRIC
287 adparts_fric => intbuf_fric_tab(intfric)%ADPARTS_FRIC
288 nsetprts = intbuf_fric_tab(intfric)%NSETPRTS
289 npartfric = intbuf_fric_tab(intfric)%S_TABPARTS_FRIC
291 tabcoupleparts_fric => tabcoupleparts_fric_bid
292 tabparts_fric => tabparts_fric_bid
293 tabcoef_fric => tabcoef_fric_bid
294 adparts_fric => adparts_fric_bid
295 ifricorth => ifricorth_bid
301 i_stok = intbuf_tab%I_STOK(1)
305 nb_loc = i_stok / nthread
306 IF (jtask==nthread)
THEN
307 i_stok_loc = i_stok-nb_loc*(nthread-1)
311 debut = (jtask-1)*nb_loc
320 DO i = debut+1, debut+i_stok_loc
321 j=intbuf_tab%CAND_N(i)
323 IF(abs(intbuf_tab%IRTLM(1+2*(j-1)))==intbuf_tab%CAND_E(i))
THEN
334 IF(isensint(i)/=0)
THEN
335 sfsavparit = sfsavparit + 1
338 IF (sfsavparit /= 0)
THEN
339 ALLOCATE(fsavparit(nisub+1,11,i_stok),stat=ierror)
341 CALL ancmsg(msgid=19,anmode=aninfo,
342 . c1=
'(/INTER/TYPE21)')
348 fsavparit(h,i,j) = zero
353 ALLOCATE(fsavparit(0,0,0),stat=ierror)
355 CALL ancmsg(msgid=19,anmode=aninfo,
356 . c1=
'(/INTER/TYPE21)')
362 IF (debug(3)>=1)
THEN
363 nb_jlt = nb_jlt + i_stok_loc
364 nb_stok_n = nb_stok_n + i_stok
367 DO nft = 0 , i_stok - 1 , nvsiz
368 jlt =
min( nvsiz, i_stok - nft )
371 1 jlt,index2(nft+1),intbuf_tab%CAND_E,intbuf_tab%CAND_N,
375 1 jlt ,nin ,x ,intbuf_tab%IRECTM,nsn ,
376 2 intbuf_tab%NSV,cand_e_n ,cand_n_n ,intbuf_tab%STF,
378 3 intbuf_tab%XM0,intbuf_tab%NOD_NORMAL,intbuf_tab%IRTLM,intbuf_tab%CSTS,
380 4 ms ,v ,xi ,yi ,zi ,
381 5 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
382 6 igsti ,stif ,kmin ,kmax ,igap ,
383 7 gap ,intbuf_tab%GAP_S,gapv ,gapmax ,gapmin ,
384 8 nx ,ny ,nz ,pene ,vxm ,
385 9 vym ,vzm ,vxi ,vyi ,vzi ,
386 a msi ,itria ,lb ,lc ,iadm ,
387 b intbuf_tab%RCURV,intbuf_tab%ANGLM,nradm ,anglt ,rcurvi,
388 c anglmi ,fxt ,fyt ,fzt ,intbuf_tab%FTSAVX,
389 d intbuf_tab%FTSAVY,intbuf_tab%FTSAVZ ,intbuf_tab%GAP_S(1+nsn),
390 . intbuf_tab%AREAS,gap0 ,
391 e area0 ,intth ,temp ,tempi ,irot ,
392 f xg ,rot ,intbuf_tab%AS,intbuf_tab%BS,asi ,
393 g bsi ,xp ,yp ,zp ,nodnx_sms ,
394 h nsms ,mstr ,intbuf_tab%PENIS,intbuf_tab%IFPEN,ilev,
395 i x1 ,y1 ,z1 ,x2 ,y2 ,
397 k y4 ,z4 ,drad ,penrad ,tint ,
398 l tempm ,iform_the ,h1 ,h2 ,h3 ,
399 m h4 ,dist ,itab ,noint ,intbuf_tab%VARIABLES(23),
400 n invn , intfric,intbuf_tab%IPARTFRICS,ipartfricsi,intbuf_tab%IPARTFRICM,
401 o ipartfricmi,ipari(5,nin) )
406 IF(jtask==1)
CALL startime(timers,macro_timer_fric)
412 1 intfric ,jlt ,ipartfricsi ,ipartfricmi ,adparts_fric ,
413 2 nsetprts ,tabcoupleparts_fric,npartfric,tabparts_fric
414 3 fric ,viscf ,intbuf_tab%FRIC_P,fric_coefs , fricc ,
415 4 viscffric ,nty ,mfrot ,iorthfric ,ifric ,
416 5 jj , tint ,tempi ,npc ,tf ,
417 6 temp , h1 ,h2 ,h3 ,h4 ,
418 7 ix1 , ix2 ,ix3 ,ix4
420 IF(jtask==1)
CALL stoptime(timers,macro_timer_fric)
422 IF (imonm > 0 .AND. jtask == 1)
CALL startime(timers,20)
426 . nb_jlt_new = nb_jlt_new + jlt
429 1 jlt ,nin ,noint ,ibc ,icodt ,
430 2 fsav ,gap ,stiglo ,visc ,inacti ,
431 3 mfrot ,ifq ,ibag ,iadm ,ipari(39,nin) ,
432 4 stif ,gapv ,itab ,intbuf_tab%PENIS,intbuf_tab%ALPHA0,
433 5 intbuf_tab%IFPEN ,icontact ,rcontact,acontact ,pcontact,
434 6 nsvg ,x1 ,y1 ,z1 ,x2 ,
435 7 y2 ,z2 ,x3 ,y3 ,z3 ,
436 8 x4 ,y4 ,z4 ,xi ,yi ,
437 9 zi ,vxi ,vyi ,vzi ,msi ,
438 a vxm ,vym ,vzm ,nx ,ny ,
439 b nz ,pene ,fxt ,fyt ,fzt ,
440 c fxn ,fyn ,fzn ,rcurvi ,anglmi ,
441 d padm ,cand_n_n,weight ,igap ,gap0 ,
442 e area0 ,pmax ,irot ,xg ,mxi ,
443 g myi ,mzi ,
stri ,wxm ,wym ,
444 h wzm ,xp ,yp ,zp ,kt ,
445 i c ,ilev ,fni ,intth ,fheat ,
446 j efrict ,qfricint(nin),ifric ,xfric ,tempi ,
447 k tempm ,npc ,tf ,ix1 ,ix2 ,
448 l ix3 ,ix4 ,dt2t ,neltst ,ityptst ,
449 m kinet ,nisub ,isensint ,fsavparit,nft ,
450 n iftlim ,ninskid ,pratio ,pmaxskid ,interefric ,
451 o efric_l ,fricc ,fric_coefs)
454 CALL i21therm(jlt ,xi ,yi ,zi ,kthe ,
455 2 tempi ,phi ,area0 ,noint ,asi ,
456 3 bsi ,gapv ,pene ,ikthe ,xthe ,
457 4 fni ,npc ,tf ,frad ,drad ,
458 5 penrad ,tempm ,fheat ,efrict,condint,
459 6 iform_the,h1 ,h2 ,h3 ,h4 ,
460 7 phi1 ,phi2 ,phi3 ,phi4 ,x1 ,
462 9 x3 ,y3 ,z3 ,x4 ,y4 ,
463 a z4 ,itab ,nsvg ,intbuf_tab%MSR_L,ix1 ,
464 b ix2 ,ix3 ,ix4 ,temp ,fcond ,
468 IF(idtmins==2.OR.idtmins_int/=0)
THEN
470 CALL i21sms2(jlt ,mstr ,nsvg ,nin ,noint ,
471 2 mskyi_sms ,iskyi_sms,nsms ,kt ,c ,
480 IF(idtmins_int/=0)
THEN
484 CALL i21ass3(jlt ,a ,nin ,noint ,fxn ,
485 2 fyn ,fzn ,fxt ,fyt ,fzt ,
486 3 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
487 4 fcont ,fncont ,ftcont ,lb ,lc ,
488 5 itria ,stifn ,stif ,fskyi ,isky ,
489 6 isecin ,nstrf ,secfcum ,intbuf_tab%FTSAVX,
491 7 intbuf_tab%FTSAVZ ,cand_n_n ,intstamp,weight ,
493 8 intth ,phi ,fthe ,ftheskyi ,mxi ,
494 9 myi ,mzi ,
stri ,nodglob ,ncont ,
495 a indexcont,tagcont ,condn ,condint ,condnskyi,
496 b iform_the, phi1 ,phi2 ,phi3 ,phi4 ,
497 c h1 ,h2 ,h3 ,h4 ,niskyfi ,
498 d intbuf_tab%MSR_L ,itab ,h3d_data ,ninskid ,
499 e pratio ,h3d_data%N_SCAL_SKID,pskids ,ipari(95,nin),
500 f tagncont ,kloadpinter,loadpinter ,loadp_hyd_inter,
501 g dgaploadint,dist,gapv,s_loadpinter ,efric_l ,
502 h fheat ,efrict ,interefric ,
505 IF (imonm > 0 .AND. jtask == 1)
CALL stoptime(timers,20)
510 IF (sfsavparit /= 0)
THEN
512 . fbsav6, 12, 6, dimfb, isensint )
514 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)