48
49
50
51 USE intbufdef_mod
53
54
55
56#include "implicit_f.inc"
57
58
59
60#include "com08_c.inc"
61#include "param_c.inc"
62#include "parit_c.inc"
63#include "mvsiz_p.inc"
64
65
66
67 INTEGER NELTST,ITYPTST
68 INTEGER IPARI(*), ICODT(*), NPC(*), ISKY(*)
69
71 . x(*),a(*),tf(*),v(*),fsav(*),fskyi(lskyi,nfskyi),
72 . fcont(3,*),ms(*)
73
74 TYPE(INTBUF_STRUCT_) INTBUF_TAB
75 TYPE(H3D_DATABASE) :: H3D_DATA
76
77
78
79 INTEGER KD(50), JD(50), KFI, JFI,
80 . INACTI,NOINT, NGROUS, NGROUM, NG, IGIMP,INTY,IFRICF,IFRICV,
81 . IDAMPV,IDAMPF
82 INTEGER LOLD(MVSIZ)
83 INTEGER, DIMENSION(MVSIZ) :: IX1,IX2,IX3,IX4
84 my_real,
DIMENSION(MVSIZ) :: x1,x2,x3,x4,xi
85 my_real,
DIMENSION(MVSIZ) :: y1,y2,y3,y4,yi
86 my_real,
DIMENSION(MVSIZ) :: z1,z2,z3,z4,zi
87 my_real,
DIMENSION(MVSIZ) :: xface,n1,n2,n3
89 my_real,
DIMENSION(MVSIZ) :: x0,y0,z0,ans
90 my_real,
DIMENSION(MVSIZ) :: xx1,xx2,xx3,xx4
91 my_real,
DIMENSION(MVSIZ) :: yy1,yy2,yy3,yy4
92 my_real,
DIMENSION(MVSIZ) :: zz1,zz2,zz3,zz4
93 my_real,
DIMENSION(MVSIZ) :: xi1,xi2,xi3,xi4
94 my_real,
DIMENSION(MVSIZ) :: yi1,yi2,yi3,yi4
95 my_real,
DIMENSION(MVSIZ) :: zi1,zi2,zi3,zi4
96 my_real,
DIMENSION(MVSIZ) :: xn1,xn2,xn3,xn4
97 my_real,
DIMENSION(MVSIZ) :: yn1,yn2,yn3,yn4
98 my_real,
DIMENSION(MVSIZ) :: zn1,zn2,zn3,zn4
99 my_real,
DIMENSION(MVSIZ) :: xp,yp,zp
100 my_real,
DIMENSION(MVSIZ) :: h1,h2,h3,h4
102 . vni(mvsiz),vnt(mvsiz)
104 . ansmx,ascalv,ascalf,fscalv,fmx,fmy,fmz,startt,fric,sfric,visc,
105 . stiff, gap, stopt,dist
106 INTEGER :: ,NMN
107 INTEGER :: NFT,LLT,LFT
108
109 nsn = ipari(5)
110 nmn = ipari(6)
111 inty = ipari(7)
112 noint = ipari(15)
113 inacti= ipari(22)
114 ifricf = ipari(51)
115 idampv = ipari(52)
116 idampf = ipari(53)
117 ifricv = ipari(54)
118
119 ansmx =ep15
120 fmx=zero
121 fmy=zero
122 fmz=zero
123
124 ngrous=1+(nsn-1)/nvsiz
125 ngroum=1+(nmn-1)/nvsiz
126
127 startt=intbuf_tab%VARIABLES(3)
128 IF(startt > tt) RETURN
129 stopt =intbuf_tab%VARIABLES(11)
130 IF(tt > stopt) RETURN
131
132 fric = intbuf_tab%VARIABLES(1)
133 gap = intbuf_tab%VARIABLES(2)
134 sfric = intbuf_tab%VARIABLES(5)
135 visc = intbuf_tab%VARIABLES(14)
136 stiff = intbuf_tab%VARIABLES(21)
137 ascalf= intbuf_tab%VARIABLES(22)
138 ascalv= intbuf_tab%VARIABLES(23)
139 fscalv= intbuf_tab%VARIABLES(24)
140
141 CALL i6ini3(intbuf_tab%FS,intbuf_tab%FM,nsn,nmn)
142
143
144
145 DO ng=1,ngrous
146 nft=(ng-1)*nvsiz
147 lft=1
148 llt=min0(nvsiz,nsn-nft)
150 1 x, intbuf_tab%IRECTM,intbuf_tab%LMSR, intbuf_tab%MSR,
151 2 intbuf_tab%NSV, intbuf_tab%ILOCS, intbuf_tab%NSEGM, xi,
152 3 yi, zi, xface, lft,
153 4 llt, nft)
155 1 x, intbuf_tab%IRECTM,intbuf_tab%LMSR, intbuf_tab%MSR,
156 2 intbuf_tab%NSV, intbuf_tab%ILOCS, intbuf_tab%IRTLM, intbuf_tab%NSEGM,
157 3 xface, lft, llt, nft)
159 1 x, intbuf_tab%IRECTM,intbuf_tab%MSR, intbuf_tab%NSV,
160 2 intbuf_tab%IRTLM, ix1, ix2, ix3,
161 3 ix4, x1, x2, x3,
162 4 x4, y1, y2, y3,
163 5 y4, z1, z2, z3,
164 6 z4, lft, llt, nft)
166 1 x1, x2, x3, x4,
167 2 xi, y1, y2, y3,
168 3 y4, yi, z1, z2,
169 4 z3, z4, zi, xface,
170 5 n1, n2, n3, ssc,
171 6 ttc, x0, y0, z0,
172 7 xx1, xx2, xx3, xx4,
173 8 yy1, yy2, yy3, yy4,
174 9 zz1, zz2, zz3
175 a xi1, xi2, xi3, xi4,
176 b yi1, yi2, yi3, yi4,
177 c zi1, zi2, zi3, zi4,
178 d xn1, xn2, xn3, xn4,
179 e yn1, yn2, yn3, yn4,
180 f zn1, zn2, zn3, zn4,
183 1 gap,
area, thk, alp,
184 2 lft, llt)
186 1 igimp, inty, dist, x1,
187 2 x2, x3, x4, xi,
188 3 y1, y2, y3, y4,
189 4 yi, z1, z2, z3,
190 5 z4, zi, xface, n1,
191 6 n2, n3, ssc, ttc,
192 7 alp, ans, xp, yp,
193 8 zp, h1, h2, h3,
194 9 h4, lft, llt)
195 IF(igimp == 0)cycle
196
198 1 intbuf_tab%IRECTM,intbuf_tab%MSR, intbuf_tab%NSV, intbuf_tab%IRTLM,
199 2 intbuf_tab%STFM, intbuf_tab%STFNS, igimp, intbuf_tab%FS,
200 3 intbuf_tab%FM, ansmx, fmx, fmy,
201 4 fmz, intbuf_tab%FCONT, n1, n2,
202 5 n3, xface, ans, h1,
203 6 h2, h3, h4, thk,
204 7 xx3, yy3, zz3, xx4,
205 8 yy4, yi1, yi2, yi3,
206 9 zz4, zi1, zi2, zi3,
207 a xi1, xi2, xi3, xi4,
208 b lft, llt, nft)
209
210 IF (visc > zero .or. idampv > 0 .or. fric > zero)
212 1 lold, intbuf_tab%IRTLM, intbuf_tab%IRTLOM
213 2 intbuf_tab%IRECTM,intbuf_tab%MSR, intbuf_tab%NSV, v,
214 3 vni, vnt, n1, n2,
215 4 n3, ssc, ttc, h1,
216 5 h2, h3, h4, xface,
217 6 lft, llt, nft)
218
219 IF (visc > zero .or. idampv > 0)
221 1 v, npc, tf, intbuf_tab%IRECTM,
222 2 intbuf_tab%MSR, intbuf_tab%NSV, intbuf_tab%IRTLM, intbuf_tab%IRTLOM,
223 3 intbuf_tab%CSTS, intbuf_tab%FS, intbuf_tab%FM, visc,
224 4 idampv, idampf, lold, ms,
225 5 vni, ascalf, ascalv, fscalv,
226 6 h1, h2, h3, h4,
227 7 xx3, yy3, zz3, xx4,
228 8 yy4, yi1, yi2, yi3,
229 9 zz4, zi1, zi2, zi3,
230 a xi1, xi2, xi3, xi4,
231 b lft, llt, nft)
232
233 IF (fric > zero)
235 1 x, intbuf_tab%IRECTM,intbuf_tab%MSR, intbuf_tab%NSV,
236 2 intbuf_tab%IRTLM, intbuf_tab%CSTS, intbuf_tab%IRTLOM,intbuf_tab%FRICOS,
237 3 fric, intbuf_tab%FS, intbuf_tab%FM, sfric,
238 4 ifricf, npc, tf, lold,
239 5 ifricv, vnt, ascalf, ascalv
240 6 stiff, n1, n2, n3,
241 7 ssc, ttc, xface, xp
242 8 yp, zp, h1, h2,
243 9 h3, h4, xx3, yy3,
244 a zz3, xx4, yy4, yi1,
245 b yi2, yi3, zz4, zi1,
246 c zi2, zi3, xi1, xi2,
247 d xi3, xi4, lft, llt,
248 e nft)
249
250
251 ENDDO
252
253
254
255 fmx=-fmx
256 fmy=-fmy
257 fmz=-fmz
258
259
260
261 DO ng=1,ngroum
262 nft=(ng-1)*nvsiz
263 lft=1
264 llt=min0(nvsiz,nmn-nft)
266 1 x, intbuf_tab%IRECTS,intbuf_tab%LNSV, intbuf_tab%NSV,
267 2 intbuf_tab%MSR, intbuf_tab%ILOCM, intbuf_tab%NSEGS, xi,
268 3 yi, zi, xface, lft,
269 4 llt, nft)
271 1 x, intbuf_tab%IRECTS,intbuf_tab%LNSV, intbuf_tab%NSV,
272 2 intbuf_tab%MSR, intbuf_tab%ILOCM, intbuf_tab%IRTLS, intbuf_tab%NSEGS,
273 3 xface, lft, llt, nft)
275 1 x, intbuf_tab%IRECTS,intbuf_tab%NSV, intbuf_tab%MSR,
276 2 intbuf_tab%IRTLS, ix1, ix2, ix3,
277 3 ix4, x1, x2, x3,
278 4 x4, y1, y2, y3,
279 5 y4, z1, z2, z3,
280 6 z4, lft, llt, nft)
281
283 1 x1, x2, x3, x4,
284 2 xi, y1, y2, y3,
285 3 y4, yi, z1, z2,
286 4 z3, z4, zi, xface,
287 5 n1, n2, n3, ssc,
288 6 ttc, x0, y0, z0,
289 7 xx1, xx2, xx3, xx4,
290 8 yy1, yy2, yy3, yy4,
291 9 zz1, zz2, zz3, zz4,
292 a xi1, xi2, xi3, xi4,
293 b yi1, yi2, yi3, yi4,
294 c zi1, zi2, zi3, zi4,
295 d xn1, xn2, xn3, xn4,
296 e yn1, yn2, yn3, yn4,
297 f zn1, zn2, zn3, zn4,
300 1 gap,
area, thk, alp,
301 2 lft, llt)
303 1 igimp, inty, dist, x1,
304 2 x2, x3, x4, xi,
305 3 y1, y2, y3, y4,
306 4 yi, z1, z2, z3,
307 5 z4, zi, xface, n1,
308 6 n2, n3, ssc, ttc,
309 7 alp, ans, xp, yp,
310 8 zp, h1, h2, h3,
311 9 h4, lft, llt)
312
313 IF (igimp == 0) cycle
314
316 1 intbuf_tab%IRECTS,intbuf_tab%NSV, intbuf_tab%MSR, intbuf_tab%IRTLS,
317 2 intbuf_tab%STFS, intbuf_tab%STFNM, igimp, intbuf_tab%FM,
318 3 intbuf_tab%FS, ansmx, fmx, fmy,
319 4 fmz, intbuf_tab%FCONT, n1, n2,
320 5 n3, xface, ans, h1,
321 6 h2, h3, h4, thk,
322 7 xx3, yy3, zz3, xx4,
323 8 yy4, yi1, yi2, yi3,
324 9 zz4, zi1, zi2, zi3,
325 a xi1, xi2, xi3, xi4,
326 b lft, llt, nft)
327
328 IF (visc > zero .or. idampv > 0 .or. fric > zero)
330 1 lold, intbuf_tab%IRTLS, intbuf_tab%IRTLOS,intbuf_tab%CSTM,
331 2 intbuf_tab%IRECTS,intbuf_tab%NSV, intbuf_tab%MSR, v,
332 3 vni, vnt, n1, n2,
333 4 n3, ssc, ttc, h1,
334 5 h2, h3, h4, xface,
335 6 lft, llt, nft)
336
337 IF (visc > zero .or. idampv > 0)
339 1 v, npc, tf, intbuf_tab%IRECTS,
340 2 intbuf_tab%NSV, intbuf_tab%MSR, intbuf_tab%IRTLS, intbuf_tab%IRTLOS,
341 3 intbuf_tab%CSTM, intbuf_tab%FM, intbuf_tab%FS, visc,
342 4 idampv, idampf, lold, ms,
343 5 vni, ascalf, ascalv, fscalv,
344 6 h1, h2, h3, h4,
345 7 xx3, yy3, zz3, xx4,
346 8 yy4, yi1, yi2, yi3,
347 9 zz4, zi1, zi2, zi3,
348 a xi1, xi2, xi3, xi4,
349 b lft, llt, nft)
350
351 IF (fric > zero)
353 1 x, intbuf_tab%IRECTS,intbuf_tab%NSV, intbuf_tab%MSR,
354 2 intbuf_tab%IRTLS, intbuf_tab%CSTM, intbuf_tab%IRTLOS,intbuf_tab%FRICOM,
355 3 fric, intbuf_tab%FM, intbuf_tab%FS, sfric,
356 4 ifricf, npc, tf, lold,
357 5 ifricv, vnt, ascalf, ascalv,
358 6 stiff, n1, n2, n3,
359 7 ssc, ttc, xface, xp,
360 8 yp, zp, h1, h2,
361 9 h3, h4, xx3, yy3,
362 a zz3, xx4, yy4, yi1,
363 b yi2, yi3, zz4, zi1,
364 c zi2, zi3, xi1, xi2,
365 d xi3, xi4, lft, llt,
366 e nft)
367 ENDDO
368
370 1 a ,intbuf_tab%MSR ,intbuf_tab%NSV ,intbuf_tab%FS ,
371 2 intbuf_tab%FM ,npc ,tf ,ansmx ,
372 3 fmx ,fmy ,fmz ,intbuf_tab%VARIABLES(4),
373 4 ipari(11) ,v ,noint ,nsn ,
374 5 nmn ,fsav ,dt2t ,neltst ,
375 6 ityptst ,intbuf_tab%STFAC(1) ,fskyi ,isky ,
376 7 fcont,intbuf_tab%VARIABLES(19),intbuf_tab%VARIABLES(20),stiff ,
377 8 ipari(47) ,ipari(49) ,ipari(58) ,intbuf_tab%FCONT ,
378 9 intbuf_tab%ANSMX0(1) ,intbuf_tab%ANSMX0(2),h3d_data )
379
380 RETURN
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine i3cor3(x, irect, msr, nsv, irtl, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, lft, llt, nft)
subroutine i3cst3(x1, x2, x3, x4, xi, y1, y2, y3, y4, yi, z1, z2, z3, z4, zi, xface, n1, n2, n3, ssc, ttc, x0, y0, z0, xx1, xx2, xx3, xx4, yy1, yy2, yy3, yy4, zz1, zz2, zz3, zz4, xi1, xi2, xi3, xi4, yi1, yi2, yi3, yi4, zi1, zi2, zi3, zi4, xn1, xn2, xn3, xn4, yn1, yn2, yn3, yn4, zn1, zn2, zn3, zn4, area, lft, llt)
subroutine i3dis3(igimp, nty, dist, x1, x2, x3, x4, xi, y1, y2, y3, y4, yi, z1, z2, z3, z4, zi, xface, n1, n2, n3, ssc, ttc, alp, ans, xp, yp, zp, h1, h2, h3, h4, lft, llt)
subroutine i3gap3(gap, area, thk, alp, lft, llt)
subroutine i3loc3(x, irect, lmsr, msr, nsv, iloc, nseg, xi, yi, zi, xface, lft, llt, nft)
subroutine i3msr3(x, irect, lmsr, msr, nsv, iloc, irtl, nseg, xface, lft, llt, nft)
subroutine i6ass3(e, msr, nsv, es, em, npc, tf, ansmx, fmx, fmy, fmz, xmas, ifunc, v, noint, nsn, nmn, fsav, dt2t, neltst, ityptst, ffac, fskyi, isky, fcont, facx, fac2, stiff, hflag, ifun2, icor, peni, ansmx0, ff0, h3d_data)
subroutine i6damp(v, npc, tf, irect, msr, nsv, irtl, irtlo, cst, es, em, visc, ndamp1, ndamp2, lold, mass, vni, ascalf, ascalv, fscalv, h1, h2, h3, h4, fni, fxi, fyi, fzi, fx1, fx2, fx3, fx4, fy1, fy2, fy3, fy4, fz1, fz2, fz3, fz4, lft, llt, nft)
subroutine i6for3(irect, msr, nsv, irtl, stf, stfn, igimp, es, em, ansmx, fmx, fmy, fmz, peni, n1, n2, n3, xface, ans, h1, h2, h3, h4, thk, fni, fxi, fyi, fzi, fx1, fx2, fx3, fx4, fy1, fy2, fy3, fy4, fz1, fz2, fz3, fz4, lft, llt, nft)
subroutine i6fri3(x, irect, msr, nsv, irtl, cst, irtlo, fric0, fric, es, em, sfric, ifricf, npc, tf, lold, ifricv, vnt, ascalf, ascalv, stiff, n1, n2, n3, ssc, ttc, xface, xp, yp, zp, h1, h2, h3, h4, fni, fxi, fyi, fzi, fx1, fx2, fx3, fx4, fy1, fy2, fy3, fy4, fz1, fz2, fz3, fz4, lft, llt, nft)
subroutine i6ipmact(lold, irtl, irtlo, cst, irect, msr, nsv, v, vni, vnt, n1, n2, n3, ssc, ttc, h1, h2, h3, h4, xface, lft, llt, nft)
subroutine i6ini3(es, em, nsn, nmn)