63
64
65
66
67
68
69
70
71
72
73 USE output_mod
74 USE timer_mod
75 USE elbufdef_mod
77 USE intbufdef_mod
81
82
83
84#include "implicit_f.inc"
85
86
87
88#include "mvsiz_p.inc"
89
90
91
92#include "com01_c.inc"
93#include "com04_c.inc"
94#include "com08_c.inc"
95#include "param_c.inc"
96#include "warn_c.inc"
97#include "task_c.inc"
98#include "parit_c.inc"
99#include "timeri_c.inc"
100
101
102
103 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
104 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
105 TYPE(TIMER_), INTENT(INOUT) :: TIMERS
106 INTEGER NELTST,ITYPTST,NIN,NEWFRONT,NSTRF(*),
107 . NRTMDIM, IAD17,NV46, ISENSINT(*),
108 INTEGER IPARI(NPARI,NINTER), (*),ICONTACT(*),
109 . ITAB(*), ISKY(*), KINET(*),
110 . IPARG(NPARG,*)
111 INTEGER NB_JLT,NB_JLT_NEW,NB_STOK_N,,
112 . NISKYFI, LINDMAX
113 INTEGER NUM_IMP,NS_IMP(*),NE_IMP(*),IND_IMP(*)
114 INTEGER IXS(*) ,IXS16(*) ,IXS20(*)
115 INTEGER IAD_ELEM(2,*),FR_ELEM(*),
116 . ISKYI_SMS(*), NODNX_SMS(*)
118 . eminx(*)
120 . x(*), a(3,*), fsav(*), v(3,*),fsavbag(*),
121 . ms(*),stifn(*),fskyi(lskyi,4),fcont(3,*),ms0(*),
122 . secfcum(7,numnod,nsect),viscn(*), fsavsub(*),
123 . fncont(3,*), ftcont(3,*), rcontact(*), acontact(*),
124 . pcontact(*),
125 . temp(*),fthe(*),ftheskyi(lskyi),pm(npropm,*),
126 . mskyi_sms(*)
127
128 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
129
130 TYPE(INTBUF_STRUCT_) INTBUF_TAB
131 TYPE(H3D_DATABASE) :: H3D_DATA
132
133 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
134
135
136
137 INTEGER I, I_STOK, JLT_NEW, JLT , NFT, IVIS2,
138 . IBC, NOINT, NSEG, ISECIN, IBAG, IADM,
139 . IGAP, INACTI, IFQ, MFROT, IGSTI, NISUB,
140 . NB_LOC, I_STOK_LOC,DEBUT,
141 . ILAGM, LENR, LENT, MAXCC,INTTH,I22GRSH3N,SFSAVPARIT,
142 . IERROR,ISU1
143 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
144 . NSVG(MVSIZ), CB_LOC(MVSIZ),CE_LOC(MVSIZ),
145 . CAND_B_N(MVSIZ),CAND_E_N(MVSIZ),KINI(MVSIZ),
146 . INDEX2(LINDMAX),
147 . ISDSIZ(NSPMD+1),IRCSIZ(NSPMD+1),ITAG(NUMNOD),
148 . IELECI(MVSIZ), NSMS(MVSIZ), IAD, J, H
150 . startt, fric, gap, stopt,
151 . visc,viscf,stiglo,gapmin,
152 . kmin, kmax, gapmax,rstif,fheat,tint,rhoh
153
155 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
156 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
157 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
158 . lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
159 . lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
160 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(mvsiz),
161 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
162 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
163 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
164 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
165 . n1(mvsiz), n2(mvsiz), n3(mvsiz), pene(mvsiz),
166 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
167 . gapv(mvsiz),vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz),
168 . tempi(mvsiz),phi(mvsiz),areasi(mvsiz)
170 . , DIMENSION(:,:),ALLOCATABLE :: surf
172 . , DIMENSION(:), ALLOCATABLE :: pres
173 SAVE surf,pres
175 . anglt, padm
176 INTEGER NRTMFT, NRTMLT, NMNFT, NMNLT, NRADM
178 . nnx1(mvsiz), nnx2(mvsiz), nnx3(mvsiz), nnx4(mvsiz),
179 . nny1(mvsiz), nny2(mvsiz), nny3(mvsiz), nny4(mvsiz),
180 . nnz1(mvsiz), nnz2(mvsiz), nnz3(mvsiz), nnz4(mvsiz),
184 INTEGER ICURV
185 my_real,
DIMENSION(:,:,:),
ALLOCATABLE,
TARGET :: fsavparit
187 INTEGER :: NRTM, NSN, NTY
188
189 iadm = 0
190
191 nrtm = ipari(4,nin)
192 nsn = ipari(5,nin)
193 nty = ipari(7,nin)
194 noint = ipari(15,nin)
195 inacti = ipari(22,nin)
196 ibag = ipari(32,nin)
197 nisub = ipari(36,nin)
198 isu1 = ipari(45,nin)
199 intth = ipari(47,nin)
200
201
202 i22grsh3n = ipari(48,nin)
203
204 stiglo = -intbuf_tab%STFAC(1)
205 startt = intbuf_tab%VARIABLES(3)
206 stopt = intbuf_tab%VARIABLES(11)
207 fric = intbuf_tab%VARIABLES(1)
208 gap = intbuf_tab%VARIABLES(2)
209 gapmin = intbuf_tab%VARIABLES(13)
210 visc = intbuf_tab%VARIABLES(14)
211 viscf = intbuf_tab%VARIABLES(15)
212 gapmax = intbuf_tab%VARIABLES(16)
213 kmin = intbuf_tab%VARIABLES(17)
214 kmax = intbuf_tab%VARIABLES(18)
215 rstif = intbuf_tab%VARIABLES(20)
216 fheat = intbuf_tab%VARIABLES(21)
217 tint = intbuf_tab%VARIABLES(22)
218 i_stok = intbuf_tab%I_STOK(1)
219
220 debut = 0
221
222
223
224
225 IF(startt>tt) RETURN
226 IF(tt>stopt) RETURN
227
228
229
230
231 nb_loc = i_stok / nthread
232 IF (jtask==nthread) THEN
233 i_stok_loc = i_stok-nb_loc*(nthread-1)
234 ELSE
235 i_stok_loc = nb_loc
236 ENDIF
237 debut = (jtask-1)*nb_loc
238 i_stok = 0
239
240
241
242
243 DO i = debut+1, debut+i_stok_loc
244 IF(intbuf_tab%CAND_N(i)/=0) THEN
245 i_stok = i_stok + 1
246 index2(i_stok) = i
247 ENDIF
248 ENDDO
249
250
251
252
253 IF (debug(3)>=1) THEN
254 nb_jlt = nb_jlt + i_stok_loc
255 nb_stok_n = nb_stok_n + i_stok
256 ENDIF
257
258
260 IF(jtask==1)THEN
261 ALLOCATE(surf(3,nrtmdim))
262 ALLOCATE(pres(nrtmdim))
263 DO i = 1, nrtm
264 pres(i) = zero
265 surf(1,i) = zero
266 surf(2,i) = zero
267 surf(3,i) = zero
268 ENDDO
269
270
271
272
273
274
275
276
277
278
279
280 ENDIF
282
283
284 sfsavparit = 0
285 NULLIFY(pfsavparit)
286 DO i=1,nisub+1
287 IF(isensint(i)/=0) THEN
288 sfsavparit = sfsavparit + 1
289 ENDIF
290 ENDDO
291 IF (sfsavparit /= 0) THEN
292 ALLOCATE(fsavparit(nisub+1,11,i_stok),stat=ierror)
293 IF(ierror/=0) THEN
294 CALL ancmsg(msgid=19,anmode=aninfo,
295 . c1='(/INTER/TYPE22)')
297 ENDIF
298 DO j=1,i_stok
299 DO i=1,11
300 DO h=1,nisub+1
301 fsavparit(h,i,j) = zero
302 ENDDO
303 ENDDO
304 ENDDO
305 ELSE
306 ALLOCATE(fsavparit(0,0,0),stat=ierror)
307 IF(ierror/=0) THEN
308 CALL ancmsg(msgid=19,anmode=aninfo,
309 . c1='(/INTER/TYPE22)')
311 ENDIF
312 ENDIF
313
314 DO nft = 0 , i_stok - 1 , nvsiz
315
316 jlt =
min( nvsiz, i_stok - nft )
317
318
319
320
321
322
323
324
325
326
328 1 jlt ,x , intbuf_tab%IRECTM ,intbuf_tab%NSV ,cand_e_n ,
329 2 cand_b_n ,intbuf_tab%STFM , intbuf_tab%STFNS ,x1 ,x2 ,
330 3 x3 ,x4 , y1 ,y2 ,y3 ,
331 4 y4 ,z1 , z2 ,z3 ,z4 ,
332 5 xi ,yi , zi ,stif ,ix1 ,
333 6 ix2 ,ix3 , ix4 ,nsvg ,igap ,
334 7 gap ,intbuf_tab%GAP_S , intbuf_tab%GAP_M ,gapv ,ms ,
335 8 vxi ,vyi ,
336 a vzi ,msi , nsn ,v ,kinet ,
337 b kini ,nty , nin ,igsti ,kmin
338 c kmax ,gapmax , gapmin ,iadm ,index2(nft+1) ,
339 d intth ,temp , intbuf_tab%CAND_E(1) ,intbuf_tab%CAND_N(1) ,
340 e tempi ,phi , intbuf_tab%AREAS ,intbuf_tab%IELEC ,areasi ,
341 f ieleci ,nodnx_sms , nsms ,intbuf_tab%GAP_SL ,intbuf_tab%GAP_ML,
342 g igrbric(isu1)%ENTITY,jtask)
343
345 1 jlt ,cand_b_n ,cand_e_n ,cb_loc ,ce_loc ,
346 2 x1 ,x2 ,x3 ,x4
347 3 y2 ,y3 ,y4 ,z1
348 4 z3 ,z4 ,xi ,yi ,zi ,
349 5 nx1 ,nx2 ,nx3 ,nx4
350 6 ny2 ,ny3 ,ny4
351 7 nz3 ,nz4 ,lb1 ,lb2
352 8 lb4 ,lc1 ,lc2 ,lc3 ,lc4 ,
353 9 p1 ,p2 ,p3
354 a ix2 ,ix3 ,ix4 ,nsvg ,stif
355 b jlt_new ,gapv ,inacti
356 c index2(nft+1) ,vxi ,vyi ,
357 d vzi ,msi ,kini
358 e itab ,intbuf_tab%IRECTM ,intbuf_tab%I_STOK(1) ,ixs
359 f cog ,seff ,delta ,x)
360
361
362
363
364
365 jlt_new =1
366
367
368 IF (imonm > 0 .AND. jtask == 1)
CALL startime(timers,20)
369 IF(jlt_new/=0) THEN
370 ipari(29,nin) = 1
371 IF (debug(3)>=1)nb_jlt_new = nb_jlt_new + jlt_new
372 IF (sfsavparit /= 0) pfsavparit => fsavparit(1,1,nft+1)
374 1 jlt ,a ,v ,ibc ,icodt ,
375 2 fsav ,gap ,fric ,ms
376 3 viscf ,noint ,intbuf_tab%STFNS ,itab ,cb_loc
377 4 stiglo ,stifn ,stif ,fskyi ,isky ,
378 5 nx1 ,nx2 ,nx3 ,nx4 ,ny1 ,
379 6 ny2 ,ny3 ,ny4 ,nz1 ,nz2 ,
380 7 nz3 ,nz4 ,lb1 ,lb2
381 8 lb4 ,lc1 ,lc2 ,lc3 ,lc4 ,
382 9 p1 ,p2 ,p3 ,p4
383 b ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
384 c ivis2 ,neltst ,ityptst ,dt2t ,intth ,
385 d gapv ,inacti ,intbuf_tab%CAND_P ,index2(nft+1) ,niskyfi ,
386 e kinet ,newfront ,isecin ,nstrf ,secfcum ,
387 f x ,intbuf_tab%IRECTM ,ce_loc ,mfrot ,ifq ,
388 g intbuf_tab%FRIC_P ,intbuf_tab%FTSAVX ,intbuf_tab%FTSAVY
389 + intbuf_tab%XFILTR ,
390 h intbuf_tab%IFPEN ,ibag ,icontact ,
391 j viscn ,vxi ,vyi ,vzi ,msi ,
392 k kini ,nin ,nisub ,intbuf_tab%LISUB ,intbuf_tab%ADDSUBS ,
393 l intbuf_tab%ADDSUBM ,intbuf_tab%LISUBS ,intbuf_tab%LISUBM ,fsavsub ,
394 . intbuf_tab%CAND_N ,
395 m ipari(33,nin) ,ipari(39,nin) ,pres ,fncont ,ms0 ,
396 n n_scut ,surf ,cog ,cand_e_n ,seff ,
397 o elbuf_tab ,x1 ,x2 ,x3 ,x4 ,
398 3 y1 ,y2 ,y3 ,y4 ,z1 ,
399 4 z2 ,z3 ,z4 ,ixs ,nv46 ,
400 5 delta ,isensint ,pfsavparit
401 ENDIF
402 IF (imonm > 0 .AND. jtask == 1)
CALL stoptime(timers,20)
403 ENDDO
404
405
406 IF (sfsavparit /= 0)THEN
408 . fbsav6, 12, 6, dimfb, isensint )
409 ENDIF
410 IF (ALLOCATED(fsavparit)) DEALLOCATE (fsavparit)
411
412 IF(inacti==7.AND.ibag/=0)THEN
414 IF(jtask==1) THEN
415
416
417
418 END IF
420 IF(jtask == 1) DEALLOCATE(surf,pres)
421 ENDIF
422
423
425
426 IF(jtask == 1) THEN
427 IF(ALLOCATED(surf))DEALLOCATE(surf)
428 IF(ALLOCATED(pres))DEALLOCATE(pres)
429 ENDIF
430
431
432 RETURN
subroutine i22cor3(jlt, x, irect, nsv, cand_e, cand_b, stf, stfn, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, ix1, ix2, ix3, ix4, nsvg, igap, gap, gap_s, gap_m, gapv, ms, vxi, vyi, vzi, msi, nsn, v, kinet, kini, ity, nin, igsti, kmin, kmax, gapmax, gapmin, iadm, index, intth, temp, cand__e, cand__b, tempi, phi, areas, ielec, areasi, ieleci, nodnx_sms, nsms, gap_s_l, gap_m_l, bufbric, jtask)
subroutine i22for3(output, jlt, a, v, ibc, icodt, fsav, gap, fric, ms, visc, viscf, noint, stfn, itab, cb_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, intth, gapv, inacti, cand_p, index, niskyfi, kinet, newfront, isecin, nstrf, secfcum, x, irect, ce_loc, mfrot, ifq, frot_p, 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, pres, fncont, ms0, n_scut, n_surf, cog, cand_e, swet, elbuf_tab, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, ixs, nv46, delta, isensint, fsavparit, iparg, h3d_data)
subroutine i22wetsurf(jlt, cand_b, cand_e, cb_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, inacti, cand_p, n_scut, index, vxi, vyi, vzi, msi, kini, surf, ibag, itab, irect, i_stok, ixs, nft, cog, seff, delta, x)
subroutine sum_6_float_sens(f, a, b, c, jft, jlt, f6, d, e, g, isensint)
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)