89
90
91
92
93 USE timer_mod
94 USE elbufdef_mod
96 USE intbufdef_mod
97 USE multi_fvm_mod
99 USE intbuf_fric_mod
102 USE output_mod
105
106
107
108#include "implicit_f.inc"
109
110
111
112#include "mvsiz_p.inc"
113
114
115
116#include "com01_c.inc"
117#include "com04_c.inc"
118#include "com08_c.inc"
119#include "param_c.inc"
120#include "warn_c.inc"
121#include "task_c.inc"
122#include "parit_c.inc"
123#include "timeri_c.inc"
124#include "impl1_c.inc"
125#include "macro.inc"
126#include "comlock.inc"
127#include "tabsiz_c.inc"
128
129
130
131 TYPE(TIMER_), INTENT(INOUT) :: TIMERS
132 TYPE(), INTENT(INOUT) :: OUTPUT
133 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
134 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
135 INTEGER NELTST,ITYPTST,NIN,NEWFRONT,NSTRF(*),NRTMDIM, IAD17, ISENSINT(*),DIMFB,IGROUPS(NUMELS)
136 INTEGER IPARI(NPARI,NINTER), ICODT(*),ICONTACT(*),ITAB(*), ISKY(*), KINET(*),IPARG(NPARG,*),TAGNCONT(NLOADP_HYD_INTER
137INTEGER NB_JLT,NB_JLT_NEW,NB_STOK_N,,NISKYFI, LINDMAX,ITASK
138 INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),IND_IMP(*)
139 INTEGER IXS(*) ,IXS16(*) ,IXS20(*)
140 INTEGER IAD_ELEM(2,*),FR_ELEM(*), ISKYI_SMS(*), NODNX_SMS(*),NPC(*),KXIG3D(NIXIG3D,*),IXIG3D(*),IGEO(NPROPGI,*)
141 INTEGER, INTENT(IN) :: S_LOADPINTER
142 INTEGER, INTENT(IN) :: KLOADPINTER(NINTER+1),LOADPINTER(S_LOADPINTER),LOADP_HYD_INTER(NLOADP_HYD)
143 INTEGER, INTENT(IN) :: INTEREFRIC
144 INTEGER, INTENT(IN) :: NODADT_THERM
145 my_real,
intent(in) :: theaccfact
146 my_real,
INTENT(IN) :: dgaploadint(s_loadpinter)
147 my_real eminx(*), xcell(3,sxcell)
148 my_real dt2t,x(3,*), a(3,*), fsav(*), v(3,*),ms(*),stifn(*),fskyi(lskyi,4),fcont(3,*),ms0(*),
149 . secfcum(7,numnod,nsect),viscn(*), fsavsub(*),
150 . fncont(3,*), ftcont(3,*), rcontact(*), acontact(*),
151 . pcontact(*),temp(*),fthe(*),ftheskyi(lskyi),pm(npropm,*),
152 . mskyi_sms(*), qfricint(*),tf(*),condn(*),condnskyi(lskyi),wige(*),knot(*)
153 my_real knotlocpc(*),knotlocel(*)
154 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
155 INTEGER, INTENT(in) :: S_XCELL_REMOTE
156 my_real,
DIMENSION(S_XCELL_REMOTE),
INTENT(in) :: xcell_remote
157 TYPE(INTBUF_STRUCT_) INTBUF_TAB
158 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
159 TYPE(H3D_DATABASE) :: H3D_DATA
160 TYPE(INTBUF_FRIC_STRUCT_), TARGET, DIMENSION(NINTERFRIC) :: INTBUF_FRIC_TAB
161 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
162
163
164
165 INTEGER I, J, I_STOK, JLT_NEW, JLT , NFT, IVIS2,
166 . IBC, ISECIN, IBAG, IADM,
167 . IGAP, INACTI, IFQ, MFROT, IGSTI, NISUB, ITIED,
168 . JLT_TIED, NB_LOC, I_STOK_LOC,DEBUT,
169 . ILAGM, LENR, LENT, MAXCC,INTTH,IFORM, H, IERROR,
170 . SYM_FLAG_TYPE19, INTFRIC ,NSETPRTS ,NPARTFRIC ,IORTHFRIC,
171 . NFORTH ,NFISOT
172 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
173 . NSVG(MVSIZ), CN_LOC(MVSIZ),CE_LOC(MVSIZ),
174 . CAND_N_N(MVSIZ),CAND_E_N(MVSIZ),KINI(MVSIZ),
175 . INDEX2(LINDMAX),
176 . ISDSIZ(NSPMD+1),IRCSIZ(NSPMD+1),ITAG(NUMNOD),
177 . IELECI(MVSIZ), NSMS(MVSIZ), IPARTFRICSI(MVSIZ),
178 . IPARTFRICMI(MVSIZ),INDEXISOT(MVSIZ),INDEXORTH(MVSIZ),
179 . IREP_FRICMI(MVSIZ)
180 my_real startt, fric, gap, stopt,visc,viscf,stiglo,gapmin, kmin, kmax, gapmax
181
182 my_real nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
183 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
184 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
185 . lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
186 . lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
187 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(mvsiz),
188 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
189 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
190 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
191 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
192 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
193 . gapv(mvsiz),vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz),
194 . tempi(mvsiz),phi(mvsiz),areasi(mvsiz),
195 . efrict(mvsiz),fni(mvsiz),condint(mvsiz),msi_append(2*mvsiz)
196 my_real rcurvi(mvsiz), anglmi(mvsiz), anglt, padm
197 INTEGER NRTMFT, NRTMLT, NMNFT, NMNLT, NRADM,IRSTH,IFRIC
198 my_real nnx1(mvsiz), nnx2(mvsiz), nnx3(mvsiz), nnx4(mvsiz),
199 . nny1(mvsiz), nny2(mvsiz), nny3(mvsiz), nny4(mvsiz),
200 . nnz1(mvsiz), nnz2(mvsiz), nnz3(mvsiz), nnz4(mvsiz),
201 . cmaj(mvsiz)
202 INTEGER ICURV,SFSAVPARIT,NINLOADP
203 my_real drad, drad2, frad,xthe,xfric,dgaploadp
204 my_real,
DIMENSION(:,:,:),
ALLOCATABLE :: fsavparit
205 my_real ks(mvsiz),k1(mvsiz),k2(mvsiz),k3(mvsiz),k4(mvsiz),
206 . cs(mvsiz),c1(mvsiz),c2(mvsiz),c3(mvsiz),c4(mvsiz),
207 . kt(mvsiz),c(mvsiz),cf(mvsiz),
208 . fxi(mvsiz), fyi(mvsiz), fzi(mvsiz),
209 . fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
210 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz),
211 . fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz),
212 . phi1(mvsiz),phi2(mvsiz),phi3(mvsiz),phi4(mvsiz)
213 my_real xfiltr_fric,fric_coefs(mvsiz,10),viscffric(mvsiz),fricc(mvsiz),
214 . fric_coefs2(mvsiz,10),viscffric2(mvsiz),fricc2(mvsiz),
215 . dir1(mvsiz,3),dir2(mvsiz,3),dir_fricmi(mvsiz,2)
216 INTEGER, DIMENSION(:) ,POINTER :: TABCOUPLEPARTS_FRIC
217 INTEGER, DIMENSION(:) ,POINTER :: TABPARTS_FRIC
218 INTEGER, DIMENSION(:) ,POINTER :: ADPARTS_FRIC
219 INTEGER, DIMENSION(:) ,POINTER :: IFRICORTH
220 my_real,
DIMENSION(:) ,
POINTER :: tabcoef_fric
221 INTEGER,TARGET, DIMENSION(1):: TABCOUPLEPARTS_FRIC_BID
222 INTEGER,TARGET, DIMENSION(1):: TABPARTS_FRIC_BID
223 INTEGER,TARGET, DIMENSION(1):: ADPARTS_FRIC_BID
224 INTEGER,TARGET, DIMENSION(1):: IFRICORTH_BID
225 my_real,
TARGET,
DIMENSION(1):: tabcoef_fric_bid
226 INTEGER :: NSN, NTY, NOINT
227 INTEGER :: NRTM
228 LOGICAL TYPE18
229 INTEGER :: IDIR
230
231
232
233 type18 = .false.
234 nrtm = ipari(4,nin)
235 nsn = ipari(5,nin)
236 nty = ipari(7,nin)
237 ibc = ipari(11,nin)
238 ivis2 = ipari(14,nin)
239 IF(ipari(33,nin) == 1) RETURN
240 noint = ipari(15,nin)
241 igap = ipari(21,nin)
242 inacti = ipari(22,nin)
243 isecin = ipari(28,nin)
244 mfrot = ipari(30,nin)
245 ifq = ipari(31,nin)
246 ibag = ipari(32,nin)
247 igsti = ipari(34,nin)
248 nisub = ipari(36,nin)
249 icurv = ipari(39,nin)
250 itied = ipari(85,nin)
251 sym_flag_type19 = ipari(71,nin)
252
253 intth = ipari(47,nin)
254 iform = ipari(48,nin)
255 irsth = ipari(42,nin)
256
257 iadm = ipari(44,nin)
258 nradm = ipari(49,nin)
259 padm = intbuf_tab%VARIABLES(24)
260 anglt = intbuf_tab%VARIABLES(25)
261 stiglo = -intbuf_tab%STFAC(1)
262 startt = intbuf_tab%VARIABLES(3)
263 stopt = intbuf_tab%VARIABLES(11)
264 IF(startt > tt) RETURN
265 IF(tt > stopt) RETURN
266 fric = intbuf_tab%VARIABLES(1)
267 gap = intbuf_tab%VARIABLES(2)
268 gapmin = intbuf_tab%VARIABLES(13)
269 visc = intbuf_tab%VARIABLES(14)
270 viscf= intbuf_tab%VARIABLES(15)
271 ifric = 0
272 IF(intth > 0) ifric =ipari(50,nin)
273 xfric = intbuf_tab%VARIABLES(34)
274 gapmax = intbuf_tab%VARIABLES(16)
275 kmin = intbuf_tab%VARIABLES(17)
276 kmax = intbuf_tab%VARIABLES(18)
277 rstif = intbuf_tab%VARIABLES(20)
278 fheats = intbuf_tab%VARIABLES(21)
279 tint = intbuf_tab%VARIABLES(22)
280 dtmini = intbuf_tab%VARIABLES(41)
281 fheatm = intbuf_tab%VARIABLES(23)
282 xthe = intbuf_tab%VARIABLES(33)
283 frad = zero
284 drad = zero
285 drad2 = zero
286 IF(nty == 7)THEN
287 frad = intbuf_tab%VARIABLES(31)
288 drad = intbuf_tab%VARIABLES(32)
289 drad2 = drad*drad
290 ENDIF
291
292
293 intfric=ipari(72,nin)
294 iorthfric = 0
295 nsetprts = 0
296 npartfric = 0
297 xfiltr_fric = zero
298
299 IF(intfric /= 0) THEN
300 tabcoupleparts_fric => intbuf_fric_tab(intfric)%TABCOUPLEPARTS_FRIC
301 tabcoef_fric => intbuf_fric_tab(intfric)%TABCOEF_FRIC
302 tabparts_fric => intbuf_fric_tab(intfric)%TABPARTS_FRIC
303 adparts_fric => intbuf_fric_tab(intfric)%ADPARTS_FRIC
304 xfiltr_fric = intbuf_fric_tab(intfric)%XFILTR_FRIC
305 nsetprts = intbuf_fric_tab(intfric)%NSETPRTS
306 npartfric = intbuf_fric_tab(intfric)%S_TABPARTS_FRIC
307 iorthfric = intbuf_fric_tab(intfric)%IORTHFRIC
308 ifricorth => intbuf_fric_tab(intfric)%IFRICORTH
309 ELSE
310 tabcoupleparts_fric => tabcoupleparts_fric_bid
311 tabparts_fric => tabparts_fric_bid
312 tabcoef_fric => tabcoef_fric_bid
313 adparts_fric => adparts_fric_bid
314 ifricorth => ifricorth_bid
315 IF (ifq/=0) xfiltr_fric = intbuf_tab%XFILTR(1)
316 ENDIF
317
318 ninloadp = ipari(95,nin)
319 dgaploadp = intbuf_tab%VARIABLES(46)
320
321 IF(nty == 7)THEN
322 IF(inacti == 7) type18 = .true.
323 IF(type18 .AND. ipari(34,nin) == -2) RETURN
324
325
326
327 IF(icurv == 3)THEN
329 IF(jtask == 1)THEN
330 ALLOCATE(intbuf_tab%NODNORM_NORMAL (3,numnod))
331 IF(iparit == 0)THEN
332 CALL i7norm(ipari(4,nin),intbuf_tab%IRECTM,numnod,x,intbuf_tab%NODNORM_NORMAL,ipari(6,nin),intbuf_tab%MSR)
333 IF(nspmd > 1)THEN
334 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
335 CALL spmd_exch_n(intbuf_tab%NODNORM_NORMAL,iad_elem,fr_elem,lenr)
336 END IF
337 ELSE
338
339 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
340 IF(nspmd > 1)THEN
341
343 1 ipari(4,nin),intbuf_tab%IRECTM,numnod,iad_elem,fr_elem,
344 2 isdsiz ,ircsiz ,itag ,lenr ,lent ,
345 3 maxcc )
346 ELSE
347
349 1 ipari(4,nin),intbuf_tab%IRECTM,numnod,itag,lent,maxcc)
350 END IF
352 1 ipari(4,nin),intbuf_tab%IRECTM,numnod ,x ,intbuf_tab%NODNORM_NORMAL,
353 2 ipari(6,nin),intbuf_tab%MSR ,lent ,maxcc,isdsiz ,
354 3 ircsiz ,iad_elem ,fr_elem,itag )
355 END IF
356 END IF
358 ENDIF
359
360
361
362
363 IF(iadm /= 0)THEN
365 IF(jtask==1)THEN
366 ALLOCATE(intbuf_tab%MODRCURV(nrtmdim),intbuf_tab%MODANGLM(nrtmdim))
367 ALLOCATE(intbuf_tab%NODNORM_NORMAL (3,numnod))
368 IF(iparit == 0)THEN
370 . ipari(4,nin),intbuf_tab%IRECTM,numnod,x ,intbuf_tab%NODNORM_NORMAL,
371 . ipari(6,nin),intbuf_tab%MSR)
372 IF(nspmd > 1)THEN
373 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
374 CALL spmd_exch_n(intbuf_tab%NODNORM_NORMAL,iad_elem,fr_elem,lenr)
375 END IF
376 ELSE
377
378 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
379 IF(nspmd > 1)THEN
380
382 1 ipari(4,nin),intbuf_tab%IRECTM,numnod,iad_elem,fr_elem,
383 2 isdsiz ,ircsiz ,itag ,lenr ,lent ,
384 3 maxcc )
385 ELSE
386
388 1 ipari(4,nin),intbuf_tab%IRECTM,numnod,itag,lent,maxcc)
389 END IF
391 1 ipari(4,nin),intbuf_tab%IRECTM,numnod ,x ,intbuf_tab%NODNORM_NORMAL,
392 2 ipari(6,nin),intbuf_tab%MSR,lent ,maxcc,isdsiz ,
393 3 ircsiz ,iad_elem ,fr_elem,itag )
394 END IF
395 END IF
397 nmnft=1+(jtask-1)*ipari(6,nin)/nthread
398 nmnlt=jtask*ipari(6,nin)/nthread
399 CALL i7norme(nmnft,nmnlt,intbuf_tab%NODNORM_NORMAL,intbuf_tab%MSR)
401 nrtmft=1+(jtask-1)*ipari(4,nin)/nthread
402 nrtmlt=jtask*ipari(4,nin)/nthread
403 CALL i7rcurv(nrtmft, nrtmlt ,x ,intbuf_tab%NODNORM_NORMAL ,intbuf_tab%IRECTM ,
404 . intbuf_tab%MODRCURV , nradm ,intbuf_tab%MODANGLM ,anglt )
406 END IF
407
408
409 i_stok = intbuf_tab%I_STOK(1)
410 debut = 0
411 i_stok_loc = 0
412
413
414 IF(inacti /= 7 .OR. ibag == 0)THEN
415 nb_loc = i_stok / nthread
416 IF (jtask == nthread) THEN
417 i_stok_loc = i_stok-nb_loc*(nthread-1)
418 ELSE
419 i_stok_loc = nb_loc
420 ENDIF
421 debut = (jtask-1)*nb_loc
422 END IF
423 i_stok = 0
424
425 IF (impl_s == 1) THEN
426 num_imp = 0
427 visc =zero
428 viscf =zero
429 ENDIF
430
431
432
433 IF(itied == 0)THEN
434 IF (inacti == 5 .OR. inacti == 6 .OR. type18)THEN
435 DO i = debut+1, debut+i_stok_loc
436 IF(intbuf_tab%CAND_N(i)<0) THEN
437 i_stok = i_stok + 1
438 index2(i_stok) = i
439
440 intbuf_tab%CAND_N(i) = -intbuf_tab%CAND_N(i)
441 ELSE
442
443 intbuf_tab%CAND_P(i) = zero
444 ENDIF
445 ENDDO
446 ELSE
447 DO i = debut+1, debut+i_stok_loc
448 IF(intbuf_tab%CAND_N(i)<0) THEN
449 i_stok = i_stok + 1
450 index2(i_stok) = i
451
452 intbuf_tab%CAND_N(i) = -intbuf_tab%CAND_N(i)
453 ENDIF
454 ENDDO
455 ENDIF
456 ELSE
457 IF (inacti == 5 .OR. inacti == 6)THEN
458 DO i = debut+1, debut+i_stok_loc
459 IF(intbuf_tab%CAND_F(8*(i-1)+1)/=zero) THEN
460 i_stok = i_stok + 1
461 index2(i_stok) = i
462 intbuf_tab%CAND_N(i) = iabs(intbuf_tab%CAND_N(i))
463 ELSEIF(intbuf_tab%CAND_N(i)<0) THEN
464 i_stok = i_stok + 1
465 index2(i_stok) = i
466
467 intbuf_tab%CAND_N(i) = -intbuf_tab%CAND_N(i)
468 ELSE
469
470 intbuf_tab%CAND_P(i) = zero
471 intbuf_tab%CAND_F(8*(i-1)+1:8*(i-1)+8) = zero
472 ENDIF
473 ENDDO
474 ELSE
475 DO i = debut+1, debut+i_stok_loc
476 IF(intbuf_tab%CAND_F(8*(i-1)+1)/=zero) THEN
477 i_stok = i_stok + 1
478 index2(i_stok) = i
479 intbuf_tab%CAND_N(i) = iabs(intbuf_tab%CAND_N(i))
480 ELSEIF(intbuf_tab%CAND_N(i)<0) THEN
481 i_stok = i_stok + 1
482 index2(i_stok) = i
483
484 intbuf_tab%CAND_N(i) = -intbuf_tab%CAND_N(i)
485 ELSE
486 intbuf_tab%CAND_F(8*(i-1)+1:8*(i-1)+8) = zero
487 ENDIF
488 ENDDO
489 END IF
490 ENDIF
491
492
493 IF (debug(3) >= 1) THEN
494 nb_jlt = nb_jlt + i_stok_loc
495 nb_stok_n = nb_stok_n + i_stok
496 ENDIF
497
498 sfsavparit = 0
499 DO i=1,nisub+1
500 IF(isensint(i)/=0) THEN
501 sfsavparit = sfsavparit + 1
502 ENDIF
503 ENDDO
504 IF (sfsavparit /= 0) THEN
505 ALLOCATE(fsavparit(nisub+1,11,i_stok),stat=ierror)
506 IF(ierror/=0) THEN
507 CALL ancmsg(msgid=19,anmode=aninfo,c1=
'(/INTER/TYPE7)')
509 ENDIF
510 DO j=1,i_stok
511 DO i=1,11
512 DO h=1,nisub+1
513 fsavparit(h,i,j) = zero
514 ENDDO
515 ENDDO
516 ENDDO
517 ELSE
518 ALLOCATE(fsavparit(0,0,0),stat=ierror)
519 IF(ierror/=0) THEN
520 CALL ancmsg(msgid=19,anmode=aninfo,c1=
'(/INTER/TYPE7)')
522 ENDIF
523 ENDIF
524
525
526
527
528
529
530 DO nft = 0 , i_stok - 1 , nvsiz
531 jlt =
min( nvsiz, i_stok - nft )
532
533 CALL i7cdcor3(jlt,index2(nft+1),intbuf_tab%CAND_E,intbuf_tab%CAND_N,cand_e_n,cand_n_n)
534
536 1 jlt ,x ,intbuf_tab%IRECTM,intbuf_tab%NSV,cand_e_n,
537 2 cand_n_n ,intbuf_tab%STFM,intbuf_tab%STFNS,x1 ,x2 ,
538 3 x3 ,x4 ,y1 ,y2 ,y3
539 4 y4 ,z1 ,z2 ,z3 ,z4 ,
540 5 xi ,yi ,zi ,stif ,ix1 ,
541 6 ix2 ,ix3 ,ix4 ,nsvg ,igap ,
542 7 gap ,intbuf_tab%GAP_S,intbuf_tab%GAP_M,gapv ,
543 9 ms ,vxi ,vyi ,
544 a vzi ,msi ,nsn ,v ,kinet ,
545 b kini ,nty ,nin ,igsti ,kmin ,
546 c kmax ,gapmax ,gapmin ,iadm ,intbuf_tab%MODRCURV ,
547 d rcurvi ,intbuf_tab%MODANGLM ,anglmi ,intth ,temp ,
548 e tempi ,phi ,intbuf_tab%AREAS,intbuf_tab%IELEC,areasi ,
549 f ieleci ,nodnx_sms ,nsms ,intbuf_tab%GAP_SL,intbuf_tab%GAP_ML,
550 g intfric ,intbuf_tab%IPARTFRICS,ipartfricsi,intbuf_tab%IPARTFRICM,ipartfricmi,
551 h iorthfric,intbuf_tab%IREP_FRICM,intbuf_tab%DIR_FRICM,irep_fricmi,dir_fricmi )
552
553
554 jlt_new = 0
555 jlt_tied= 0
556
557 IF(type18)THEN
559 1 jlt ,cand_n_n ,cand_e_n , cn_loc ,ce_loc ,
560 2 x1 ,x2 ,x3 , x4 ,y1 ,
561 3 y2 ,y3 ,y4 , z1 ,z2 ,
562 4 z3 ,z4 ,xi , yi ,zi ,
563 5 nx1 ,nx2 ,nx3 , nx4 ,ny1 ,
564 6 ny2 ,ny3 ,ny4 , nz1 ,nz2 ,
565 7 nz3 ,nz4 ,lb1 , lb2 ,lb3 ,
566 8 lb4 ,lc1 ,lc2 , lc3 ,lc4 ,
567 9 p1 ,p2 ,p3 , p4 ,ix1 ,
568 a ix2 ,ix3 ,ix4 , nsvg ,stif ,
569 b jlt_new ,gapv ,intbuf_tab%CAND_P ,ale_connectivity%NE_CONNECT,
570 c index2(nft+1) ,vxi ,vyi ,itab ,xcell ,
571 d vzi ,msi ,kini ,
572 e igap ,multi_fvm ,s_xcell_remote ,xcell_remote)
573
574 IF( multi_fvm%IS_INT18_LAW151 ) THEN
575 msi_append(1:mvsiz) = zero
576 msi_append(mvsiz+1:2*mvsiz) = msi(1:mvsiz)
577 ELSE
578 msi_append(1:mvsiz) = msi(1:mvsiz)
579 msi_append(mvsiz+1:2*mvsiz) = zero
580 ENDIF
581
582 jlt = jlt_new
583 IF (imonm > 0 .AND. jtask == 1)
CALL startime(timers,20)
584 IF(jlt_new /= 0) THEN
585 ipari(29,nin) = 1
586 idir = ipari(34,nin)
587 IF (debug(3) >= 1)nb_jlt_new = nb_jlt_new + jlt_new
589 1 jlt ,a ,v ,ibc ,icodt ,
590 2 fsav ,gap ,fric ,ms ,visc ,
591 3 viscf ,noint ,intbuf_tab%STFNS ,itab ,cn_loc ,
592 4 stiglo ,stifn ,stif ,fskyi ,isky ,
593 5 nx1 ,nx2 ,nx3 ,nx4 ,ny1 ,
594 6 ny2 ,ny3 ,ny4 ,nz1 ,nz2 ,
595 7 nz3 ,nz4 ,lb1 ,lb2 ,lb3 ,
596 8 lb4 ,lc1 ,lc2 ,lc3 ,lc4 ,
597 9 p1 ,p2 ,p3 ,p4 ,fcont ,
598 b ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
599 c ivis2 ,neltst ,ityptst ,dt2t ,ixs ,
600 d gapv ,intbuf_tab%CAND_P ,index2(nft+1) ,niskyfi ,
601 e kinet ,newfront ,isecin ,nstrf ,secfcum ,
602 f x ,intbuf_tab%IRECTM ,ce_loc ,mfrot ,ifq ,
603 g intbuf_tab%FRIC_P ,intbuf_tab%FTSAVX ,intbuf_tab%FTSAVY ,intbuf_tab%FTSAVZ ,
604 h intbuf_tab%IFPEN , icontact ,igroups ,iparg ,
605 j viscn ,vxi ,vyi ,vzi ,msi_append ,
606 k kini ,nin ,nisub ,intbuf_tab%LISUB ,intbuf_tab%ADDSUBS,
607 l intbuf_tab%ADDSUBM,intbuf_tab%LISUBS ,intbuf_tab%LISUBM ,fsavsub ,intbuf_tab%CAND_N ,
608 m ipari(33,nin) ,ipari(39,nin) ,fncont ,ms0 ,
609 n jtask ,isensint ,fsavparit ,nft ,multi_fvm ,
610 o h3d_data ,elbuf_tab ,idir )
611 ENDIF
612
613 ELSE
615 1 jlt ,cand_n_n,cand_e_n,cn_loc ,ce_loc ,
616 2 x1 ,x2 ,x3 ,x4 ,y1 ,
617 3 y2 ,y3 ,y4 ,z1 ,z2 ,
618 4 z3 ,z4 ,xi ,yi ,zi ,
619 5 nx1 ,nx2 ,nx3 ,nx4 ,ny1 ,
620 6 ny2 ,ny3 ,ny4 ,nz1 ,nz2 ,
621 7 nz3 ,nz4 ,lb1 ,lb2 ,lb3 ,
622 8 lb4 ,lc1 ,lc2 ,lc3 ,lc4 ,
623 9 p1 ,p2 ,p3 ,p4 ,ix1 ,
624 a ix2 ,ix3 ,ix4 ,nsvg ,stif ,
625 b jlt_new ,gapv ,inacti ,intbuf_tab%CAND_P,
626 c index2(nft+1),vxi ,vyi ,
627 d vzi ,msi ,kini ,icurv ,intbuf_tab%IRECTM,
628 e nnx1 ,nnx2 ,nnx3 ,nnx4 ,nny1 ,
629 f nny2 ,nny3 ,nny4 ,nnz1 ,nnz2 ,
630 g nnz3 ,nnz4 ,intbuf_tab%NODNORM_NORMAL ,iadm,rcurvi ,
631 h anglmi ,intth ,tempi ,phi ,areasi ,
632 i ieleci ,nsms ,cmaj ,drad2 ,
633 j intfric ,ipartfricsi,
634 k ipartfricmi ,itied ,jlt_tied,intbuf_tab%CAND_F,iorthfric,
635 l irep_fricmi ,dir_fricmi,dgaploadp)
636
637 jlt = jlt_new
638 IF (imonm > 0 .AND. jtask == 1)
CALL startime(timers,20)
639 IF(jlt_new /= 0) THEN
640 ipari(29,nin) = 1
641 IF (debug(3)>=1) nb_jlt_new = nb_jlt_new + jlt_new
642
643
644
645
646 IF(itask==1)
CALL startime(timers,macro_timer_fric)
647 IF(iorthfric > 0) THEN
649 1 intfric ,jlt ,ipartfricsi ,ipartfricmi ,adparts_fric ,
650 2 nsetprts ,tabcoupleparts_fric,npartfric,tabparts_fric,tabcoef_fric ,
651 3 fric ,viscf ,intbuf_tab%FRIC_P,fric_coefs , fricc ,
652 4 viscffric ,nty ,mfrot
653 5 fricc2 ,viscffric2 ,ifricorth ,nforth , nfisot ,
654 6 indexorth ,indexisot ,jlt_tied ,irep_fricmi , dir_fricmi,
655 7 ix3 ,ix4 ,x1 ,y1 , z1 ,
656 8 x2 ,y2 ,z2 ,x3 , y3 ,
657 9 z3 ,x4 ,y4 ,z4 ,ce_loc ,
658 a dir1 ,dir2 )
659 ELSE
660 nforth = 0
661 nfisot = 0
663 1 intfric ,jlt ,ipartfricsi ,ipartfricmi ,adparts_fric ,
664 2 nsetprts ,tabcoupleparts_fric,npartfric,tabparts_fric,tabcoef_fric ,
665 3 fric ,viscf ,intbuf_tab%FRIC_P,fric_coefs , fricc ,
666 4 viscffric ,nty ,mfrot ,iorthfric , ifric ,
667 5 jlt_tied , tint ,tempi ,npc ,tf ,
668 6 temp , h1 ,h2 ,h3 ,h4 ,
669 7 ix1 , ix2 ,ix3 ,ix4 ,iform )
670 ENDIF
671 IF(itask==1)
CALL stoptime(timers,macro_timer_fric)
672
674 1 jlt ,a ,v ,ibc ,icodt ,
675 2 fsav ,gap ,fric ,ms ,visc ,
676 3 viscf ,noint ,intbuf_tab%STFNS,itab ,cn_loc ,
677 4 stiglo ,stifn ,stif ,fskyi ,isky ,
678 5 nx1 ,nx2 ,nx3 ,nx4 ,ny1 ,
679 6 ny2 ,ny3 ,ny4 ,nz1 ,nz2 ,
680 7 nz3 ,nz4 ,lb1 ,lb2 ,lb3 ,
681 8 lb4 ,lc1 ,lc2 ,lc3 ,lc4 ,
682 9 p1 ,p2 ,p3 ,p4 ,fcont ,
683 a ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
684 b ivis2 ,neltst ,ityptst ,dt2t ,gapv ,
685 c inacti,intbuf_tab%CAND_P,index2(nft+1),kinet ,newfront ,
686 d isecin ,nstrf ,x ,intbuf_tab%IRECTM,ce_loc ,
687 e mfrot ,ifq ,intbuf_tab%FTSAVX ,intbuf_tab%FTSAVY,
688 f intbuf_tab%FTSAVZ,xfiltr_fric,intbuf_tab%IFPEN ,ibag ,
689 h icontact ,viscn ,vxi ,vyi ,vzi ,
690 i msi ,kini ,nin ,nisub ,intbuf_tab%LISUB,
691 j intbuf_tab%ADDSUBS,intbuf_tab%ADDSUBM,intbuf_tab%LISUBS ,
692 . intbuf_tab%LISUBM,fsavsub,
693 k intbuf_tab%CAND_N,ipari(33,nin),ipari(39,nin),intbuf_tab%NODNORM_NORMAL ,fncont,
694 l ftcont ,x1 ,x2 ,x3 ,x4 ,
695 m y1 , y2 ,y3 ,y4 ,z1 ,
696 n z2 ,z3 ,z4 ,xi ,yi ,
697 o zi ,iadm ,rcurvi ,rcontact ,acontact ,
698 p pcontact ,anglmi ,padm ,intth ,temp ,
699 q tempi ,iform ,npc ,tf ,cmaj ,
700 r dtmini ,drad ,fheats ,fheatm ,efrict ,
701 s qfricint(nin),fni ,ifric ,jtask ,h1 ,
702 u h2 ,h3 ,h4 ,ks ,kt ,
703 v k1 ,k2 ,k3 ,k4 ,c1 ,
704 w c2 ,c3 ,c4 ,cs ,c ,
705 x cf ,tint ,xfric ,fxi ,fyi ,
706 y fzi ,fx1 ,fy1 ,fz1 ,fx2 ,
707 z fy2 ,fz2 ,fx3 ,fy3 ,fz3 ,
708 1 fx4 ,fy4 ,fz4 ,isensint ,fsavparit ,
709 5 nft ,sym_flag_type19,h3d_data,fricc ,viscffric ,
710 6 fric_coefs ,itied ,jlt_tied ,intbuf_tab%CAND_F,iorthfric,
711 7 fric_coefs2 ,fricc2 ,viscffric2 ,nforth ,nfisot ,
712 8 indexorth ,indexisot ,dir1 ,dir2 ,tagncont ,
713 9 kloadpinter ,loadpinter ,loadp_hyd_inter,intbuf_tab%TYPSUB ,
714 . intbuf_tab%INFLG_SUBS,
715 a intbuf_tab%INFLG_SUBM,ninloadp,dgaploadint,s_loadpinter,dgaploadp,
716 b interefric )
717
718 IF( intth > 0 ) THEN
719 CALL i7therm(jlt ,iparg ,pm ,ixs ,iform ,x ,
720 1 xi ,yi ,zi ,x1 ,y1 ,z1 ,
721 2 x2 ,y2 ,z2 ,x3 ,y3 ,z3 ,
722 3 x4 ,y4 ,z4 ,ix1 ,ix2 ,ix3 ,
723 4 ix4 ,rstif ,tempi, intbuf_tab%IELEC ,
724 5 phi ,tint , areasi,ieleci ,frad,drad ,
725 6 gapv ,fni ,irsth,xthe ,npc ,tf ,
726 6 condint,phi1,phi2 ,phi3 ,phi4 ,fheats,
727 7 fheatm,efrict,temp ,h1 ,h2 ,h3 ,
728 8 h4 ,theaccfact)
729 ENDIF
730
732 1 jlt ,a ,noint ,itab ,stifn ,
733 2 stif ,fskyi ,isky ,fcont ,ix1 ,
734 3 ix2 ,ix3 ,ix4 ,nsvg ,neltst ,
735 4 ityptst ,dt2t ,niskyfi ,isecin ,nstrf ,
736 5 secfcum ,viscn ,nin ,fxi ,fyi ,
737 6 fzi ,fx1 ,fy1 ,fz1 ,fx2 ,
738 7 fy2 ,fz2 ,fx3 ,fy3 ,fz3 ,
739 8 fx4 ,fy4 ,fz4 ,h1 ,h2 ,
740 9 h3 ,h4 ,ks ,kt ,k1 ,
741 a k2 ,k3 ,k4 ,cs ,cf ,
742 b c1 ,c2 ,c3 ,c4 ,c ,
743 c intth ,phi ,phi1 ,phi2 ,phi3 ,
744 d phi4 ,fthe ,ftheskyi ,mskyi_sms ,iskyi_sms ,
745 e nsms ,dtmini ,jtask ,
746 f condn ,condint ,condnskyi ,ixig3d ,kxig3d ,
747 j wige ,knot ,igeo ,intbuf_tab%NIGE ,
748 k intbuf_tab%RIGE ,x ,h3d_data ,knotlocpc ,
749 l knotlocel ,iform ,nodadt_therm)
750
751 ENDIF
752 ENDIF
753
754
755
756 IF (imonm > 0 .AND. jtask == 1)
CALL stoptime(timers,20)
757 IF(impl_s = =1) THEN
758 DO i = 1 ,jlt_new
759 ns_imp(i+num_imp)=cn_loc(i)
760 ne_imp(i+num_imp)=ce_loc(i)
761 ind_imp(i+num_imp)=index2(i+nft)
762 ENDDO
763 num_imp=num_imp+jlt_new
764 ENDIF
765 ENDDO
766
767 IF (sfsavparit /= 0)THEN
768 CALL sum_6_float_sens(fsavparit, nisub+1, 11, i_stok,1,i_stok, fbsav6, 12, 6, dimfb, isensint )
769 ENDIF
770 IF (ALLOCATED(fsavparit)) DEALLOCATE (fsavparit)
771
772 IF(icurv == 3 .OR. iadm /= 0)THEN
774 IF(jtask==1)DEALLOCATE(intbuf_tab%NODNORM_NORMAL)
775 END IF
776 IF(iadm/=0)THEN
778 IF(jtask==1)DEALLOCATE(intbuf_tab%MODRCURV,intbuf_tab%MODANGLM)
779 END IF
780 ELSEIF(nty==17)THEN
781 ilagm = ipari(33,nin)
782
783 IF(ilagm == 0)THEN
785 1 nin ,ipari ,intbuf_tab ,x ,v ,
786 2 a ,jtask-1,igrbric ,eminx(iad17),ms ,
787 3 ixs ,ixs16 ,ixs20 ,stifn ,fskyi ,isky ,
788 4 fsav ,fcont ,niskyfi ,h3d_data)
789 ENDIF
790 ENDIF
791
792 RETURN
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)
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 i17main_pena(output, nin, ipari, intbuf_tab, x, v, a, itask, igrbric, eminx, ms, ixs, ixs16, ixs20, stifn, fskyi, isky, fsav, fcont, niskyfi, h3d_data)
subroutine i7ass33(jlt, a, noint, itab, stifn, stif, fskyi, isky, fcont, ix1, ix2, ix3, ix4, nsvg, neltst, ityptst, dt2t, niskyfi, isecin, nstrf, secfcum, viscn, nin, fxi, fyi, fzi, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, h1, h2, h3, h4, ks, kt, k1, k2, k3, k4, cs, cf, c1, c2, c3, c4, c, intth, phi, phi1, phi2, phi3, phi4, fthe, ftheskyi, mskyi_sms, iskyi_sms, nsms, dtmini, jtask, condn, condint, condnskyi, ixig3d, kxig3d, wige, knot, igeo, nige, rige, x, h3d_data, knotlocpc, knotlocel, iform, nodadt_therm)
subroutine i7cdcor3(jlt, index, cand_e, cand_n, cand_e_n, cand_n_n)
subroutine i7curvsz(nrtm, irect, numnod, itag, lent, maxcc)
subroutine i7normp(nrtm, irect, numnod, x, nod_normal, nmn, msr, lent, maxcc, isdsiz, ircsiz, iad_elem, fr_elem, itag)
subroutine i7norm(nrtm, irect, numnod, x, nod_normal, nmn, msr)
subroutine i7for3(output, jlt, a, v, ibcc, icodt, fsav, gap, fric, ms, visc, viscf, noint, stfn, itab, cn_loc, stiglo, stifn, stif, fskyi, isky, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, fcont, ix1, ix2, ix3, ix4, nsvg, ivis2, neltst, ityptst, dt2t, gapv, inacti, cand_p, index, kinet, newfront, isecin, nstrf, x, irect, ce_loc, mfrot, ifq, cand_fx, cand_fy, cand_fz, alpha0, ifpen, ibag, icontact, viscn, vxi, vyi, vzi, msi, kini, nin, nisub, lisub, addsubs, addsubm, lisubs, lisubm, fsavsub, cand_n, ilagm, icurv, nod_normal, fncont, ftcont, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, iadm, rcurvi, rcontact, acontact, pcontact, anglmi, padm, intth, temp, tempi, iform, npc, tf, cmaj, dtmini, drad, fheats, fheatm, efrict, qfric, fni, ifric, jtask, h1, h2, h3, h4, ks, kt, k1, k2, k3, k4, c1, c2, c3, c4, cs, c, cf, tint, xfric, fxi, fyi, fzi, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, isensint, fsavparit, nft, sym_flag_type19, h3d_data, fricc, viscffric, fric_coefs, itied, jlt_tied, cand_f, iorthfric, fric_coefs2, fricc2, viscffric2, nforth, nfisot, indexorth, indexisot, dir1, dir2, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, typsub, inflg_subs, inflg_subm, ninloadp, dgaploadint, s_loadpinter, dgaploadp, interefric)
subroutine i7rcurv(nrtmft, nrtmlt, x, nod_normal, irect, rcurv, nradm, anglm, anglt)
subroutine i7normnp(nrtm, irect, numnod, x, nod_normal, nmn, msr, lent, maxcc, isdsiz, ircsiz, iad_elem, fr_elem, itag)
subroutine i7normn(nrtm, irect, numnod, x, nod_normal, nmn, msr)
subroutine i7norme(nmnft, nmnlt, nod_normal, msr)
subroutine i7therm(jlt, iparg, pm, ixs, iform, x, xi, yi, zi, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, ix1, ix2, ix3, ix4, rstif, tempi, ieles, phi, tint, areas, ieleci, frad, drad, gapv, fni, ifunctk, xthe, npc, tf, condint, phi1, phi2, phi3, phi4, fheats, fheatm, efrict, temp, h1, h2, h3, h4, theaccfact)
subroutine i18dst3(jlt, cand_n, cand_e, cn_loc, ce_loc, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, ix1, ix2, ix3, ix4, nsvg, stif, jlt_new, gapv, cand_p, ale_ne_connect, index, vxi, vyi, itab, xcell, vzi, msi, kini, igap, multi_fvm, s_xcell_remote, xcell_remote)
subroutine i18for3(output, jlt, a, v, ibcc, icodt, fsav, gap, fric, ms, visc, viscf, noint, stfn, itab, cn_loc, stfval, stifn, stif, fskyi, isky, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, fcont, ix1, ix2, ix3, ix4, nsvg, ivis2, neltst, ityptst, dt2t, ixs, gapv, cand_p, index, niskyfi, kinet, newfront, isecin, nstrf, secfcum, x, irect, ce_loc, mfrot, ifq, frot_p, cand_fx, cand_fy, cand_fz, ifpen, icontact, igroups, iparg, viscn, vxi, vyi, vzi, msi, kini, nin, nisub, lisub, addsubs, addsubm, lisubs, lisubm, fsavsub, cand_n, ilagm, icurv, fncont, ms0, jtask, isensint, fsavparit, nft, multi_fvm, h3d_data, elbuf_tab, idir)
subroutine sum_6_float_sens(f, a, b, c, jft, jlt, f6, d, e, g, isensint)
subroutine spmd_exch_n(xnorm, iad_elem, fr_elem, lenr)
subroutine spmd_i7curvsz(nrtm, irect, numnod, iad_elem, fr_elem, isdsiz, ircsiz, itag, lenr, lent, maxcc)
subroutine i7cor3(x, irect, nsv, cand_e, cand_n, stf, stfn, gapv, igap, gap, gap_s, gap_m, istf, gapmin, gapmax, gap_s_l, gap_m_l, drad, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, dgapload, last)
subroutine i7dst3(ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, last)
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)