OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i23for3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "impl1_c.inc"
#include "parit_c.inc"
#include "scr05_c.inc"
#include "scr07_c.inc"
#include "scr11_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "scr18_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i23for3 (output, jlt, nin, noint, ibc, icodt, fsav, gap, stiglo, fric, visc, inacti, mfrot, ifq, ibag, icurv, stif, gapv, itab, a, cand_p, frot_p, alpha0, v, icontact, niskyfi, 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, h1, h2, h3, h4, index, cand_n_n, weight, fxt, fyt, fzt, dt2t, fcont, fncont, ftcont, stifn, viscn, newfront, isecin, nstrf, secfcum, fskyi, isky, intth, ms, ix1, ix2, ix3, ix4, cand_fx, cand_fy, cand_fz, kmin, kmax, cn_loc, ce_loc, mskyi_sms, iskyi_sms, nsms, jtask, isensint, fsavparit, nisub, nft, h3d_data)

Function/Subroutine Documentation

◆ i23for3()

subroutine i23for3 ( type(output_), intent(inout) output,
integer jlt,
integer nin,
integer noint,
integer ibc,
integer, dimension(*) icodt,
fsav,
gap,
stiglo,
fric,
visc,
integer inacti,
integer mfrot,
integer ifq,
integer ibag,
integer, dimension(3) icurv,
stif,
gapv,
integer, dimension(*) itab,
a,
cand_p,
frot_p,
alpha0,
v,
integer, dimension(*) icontact,
integer niskyfi,
integer, dimension(mvsiz) 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,
h1,
h2,
h3,
h4,
integer, dimension(*) index,
integer, dimension(mvsiz) cand_n_n,
integer, dimension(*) weight,
fxt,
fyt,
fzt,
dt2t,
fcont,
fncont,
ftcont,
stifn,
viscn,
integer newfront,
integer isecin,
integer, dimension(*) nstrf,
secfcum,
fskyi,
integer, dimension(*) isky,
integer intth,
ms,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
cand_fx,
cand_fy,
cand_fz,
kmin,
kmax,
integer, dimension(mvsiz) cn_loc,
integer, dimension(mvsiz) ce_loc,
mskyi_sms,
integer, dimension(*) iskyi_sms,
integer, dimension(mvsiz) nsms,
integer jtask,
integer, dimension(*) isensint,
fsavparit,
integer nisub,
integer nft,
type(h3d_database) h3d_data )

Definition at line 41 of file i23for3.F.

61C-----------------------------------------------
62C M o d u l e s
63C-----------------------------------------------
64 USE tri7box
65 USE h3d_mod
66 USE output_mod
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71#include "comlock.inc"
72C-----------------------------------------------
73C G l o b a l P a r a m e t e r s
74C-----------------------------------------------
75#include "mvsiz_p.inc"
76C-----------------------------------------------
77C C o m m o n B l o c k s
78C-----------------------------------------------
79#include "com01_c.inc"
80#include "com04_c.inc"
81#include "com06_c.inc"
82#include "com08_c.inc"
83#include "impl1_c.inc"
84#include "parit_c.inc"
85#include "scr05_c.inc"
86#include "scr07_c.inc"
87#include "scr11_c.inc"
88#include "scr14_c.inc"
89#include "scr16_c.inc"
90#include "scr18_c.inc"
91#include "sms_c.inc"
92C-----------------------------------------------
93C D u m m y A r g u m e n t s
94C-----------------------------------------------
95 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
96 INTEGER JLT, IBC, INACTI, IBAG, NIN, NOINT, INTTH,JTASK,
97 . MFROT, IFQ, ICURV(3),
98 . ICODT(*), ITAB(*) ,ICONTACT(*),
99 . NISKYFI, ISECIN, NSTRF(*),NEWFRONT, ISKY(*), ISKYI_SMS(*)
100 INTEGER NSVG(MVSIZ),CAND_N_N(MVSIZ), WEIGHT(*),
101 . IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
102 . CN_LOC(MVSIZ), CE_LOC(MVSIZ), INDEX(*), NSMS(MVSIZ),
103 . ISENSINT(*),NISUB,NFT
104 my_real
105 . stiglo, cand_p(*), frot_p(*), fsav(*), fskyi(lskyi,4),
106 . alpha0, gap, fric, visc, kmin, kmax, dt2t, mskyi_sms(*)
107 my_real
108 . stif(mvsiz), gapv(mvsiz),
109 . vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz),
110 . x1(mvsiz),y1(mvsiz),z1(mvsiz),
111 . x2(mvsiz),y2(mvsiz),z2(mvsiz),
112 . x3(mvsiz),y3(mvsiz),z3(mvsiz),
113 . x4(mvsiz),y4(mvsiz),z4(mvsiz),
114 . xi(mvsiz),yi(mvsiz),zi(mvsiz),
115 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
116 . nx(mvsiz),ny(mvsiz),nz(mvsiz),pene(mvsiz),
117 . vxm(mvsiz), vym(mvsiz), vzm(mvsiz),
118 . fxt(mvsiz), fyt(mvsiz), fzt(mvsiz)
119 my_real
120 . a(3,*), v(3,*), ms(*),
121 . fcont(3,*), fncont(3,*),ftcont(3,*), stifn(*), viscn(*),
122 . secfcum(7,numnod,nsect),
123 . cand_fx(*), cand_fy(*), cand_fz(*),fsavparit(nisub+1,11,*)
124 TYPE(H3D_DATABASE) :: H3D_DATA
125C-----------------------------------------------
126C L o c a l V a r i a b l e s
127C-----------------------------------------------
128 INTEGER I, J1, IG, J, JG , K0,NBINTER,K1S,K, NN,IBID,
129 . IBCM,IBCS
130 my_real
131 . fxi(mvsiz), fyi(mvsiz), fzi(mvsiz),fni(mvsiz),
132 . fxn(mvsiz), fyn(mvsiz), fzn(mvsiz),
133 . fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
134 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz),
135 . fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz),
136 . xmu(mvsiz),
137 . vx(mvsiz), vy(mvsiz), vz(mvsiz), vn(mvsiz),
138 . aa, dti,
139 . v2, alpha, beta,
140 . fx, fy, fz, ft, fn, ftn,
141 . econtt, econvt,econtdt,
142 . fsav1, fsav2, fsav3, fsav4, fsav5, fsav6, fsav8,
143 . fsav9, fsav10, fsav11, fsav12, fsav13, fsav14, fsav15,
144 . vv,ax1,ax2,ay1,ay2,az1,az2,ax,ay,az,area,p,vv1,vv2,dmu,
145 . dt1inv, vis, rbid,
146 . impx,impy,impz
147 my_real
148 . prec
149 my_real
150 . stif0(mvsiz),
151 . st1(mvsiz),st2(mvsiz),st3(mvsiz),st4(mvsiz),stv(mvsiz),
152 . kt(mvsiz),c(mvsiz),cf(mvsiz),
153 . ks(mvsiz),k1(mvsiz),k2(mvsiz),k3(mvsiz),k4(mvsiz),
154 . cs(mvsiz),c1(mvsiz),c2(mvsiz),c3(mvsiz),c4(mvsiz),
155 . cx,cy,aux,dtmini
156C-----------------------------------------------
157 rbid = zero
158 ibid = 0
159 IF (iresp==1) THEN
160 prec = fiveem4
161 ELSE
162 prec = em10
163 ENDIF
164 IF(dt1>zero)THEN
165 dt1inv = one/dt1
166 ELSE
167 dt1inv =zero
168 ENDIF
169C---------------------
170C PENE INITIALE
171C---------------------
172 IF(inacti==6)THEN
173 DO i=1,jlt
174C REDUCTION OF THE INITIAL PENALTY
175 cand_p(index(i))=min(cand_p(index(i)),
176 . ( (one-fiveem2)*cand_p(index(i))
177 . +fiveem2*(pene(i)+fiveem2*max(gapv(i)-pene(i),zero))) )
178C SUBTRACTION OF THE INITIAL PENALTY FROM THE PENALTY AND GAP
179 pene(i)=max(zero,pene(i)-cand_p(index(i)))
180 IF( pene(i)==zero ) stif(i) = zero
181 ENDDO
182 ELSE
183 DO i=1,jlt
184C REDUCTION OF THE INITIAL PENALTY
185 cand_p(index(i))=min(cand_p(index(i)),
186 . ((one-fiveem2)*cand_p(index(i))+fiveem2*pene(i)) )
187C SUBTRACTION OF THE INITIAL PENALTY FROM THE PENALTY AND GAP
188 pene(i)=max(zero,pene(i)-cand_p(index(i)))
189 IF( pene(i)==zero ) stif(i) = zero
190 ENDDO
191 END IF
192C-------------------------------------------
193C FNI + STIF
194C---------------------------------
195 econtt = zero
196 econvt = zero
197 econtdt = zero
198 DO i=1,jlt
199 IF(stiglo<=zero)THEN
200 stif(i) = -stiglo*stif(i)
201 ELSEIF(stif(i)/=zero)THEN
202 IF(stif(i)/=zero) stif(i) = stiglo
203 ENDIF
204 IF(stif(i)/=zero)stif(i)=min(kmax,max(kmin,stif(i)))
205 econtt = econtt + stif(i)*pene(i)**2
206 fni(i) = - stif(i) * pene(i)
207 END DO
208C
209 DO i=1,jlt
210 stif0(i) = stif(i)
211 ENDDO
212C---------------------------------
213C DAMPING
214C---------------------------------
215 DO i=1,jlt
216 vx(i) = vxi(i)-vxm(i)
217 vy(i) = vyi(i)-vym(i)
218 vz(i) = vzi(i)-vzm(i)
219 vn(i) = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
220 ENDDO
221C
222 IF(kdtint==0.AND.(idtmins/=2.AND.idtmins_int==0))THEN
223 DO i=1,jlt
224 vis = visc * sqrt(two * stif(i) * msi(i))
225 fni(i) = fni(i) + vis * vn(i)
226 econtdt = econtdt + vis * vn(i) * vn(i) * dt1
227C stability only
228C inutile STIF(I) = TWO * (STIF(I) + VIS *DT1INV)
229 stif(i) = stif(i) + vis *dt1inv
230 ENDDO
231 ELSE
232 DO i=1,jlt
233 c(i) = visc * sqrt(two * stif(i) * msi(i))
234 fni(i) = fni(i) + c(i) * vn(i)
235 econtdt= econtdt + c(i) * vn(i) * vn(i) * dt1
236C stability only
237C inutile C(I) = TWO*C(I)
238C inutile KT(I)= TWO*STIF(I)
239 c(i) = c(i)
240 kt(i)= stif(i)
241 cf(i)= zero
242 stif(i) = kt(i) + c(i) *dt1inv
243 ENDDO
244 END IF
245C---------------------------------
246C CALCULATION OF THE NORMAL FORCE
247C---------------------------------
248 DO i=1,jlt
249 fxn(i)=fni(i)*nx(i)
250 fyn(i)=fni(i)*ny(i)
251 fzn(i)=fni(i)*nz(i)
252 END DO
253C---------------------------------
254C SAUVEGARDE DE L'IMPULSION NORMALE
255C---------------------------------
256 fsav1 = zero
257 fsav2 = zero
258 fsav3 = zero
259 fsav8 = zero
260 fsav9 = zero
261 fsav10= zero
262 fsav11= zero
263 DO i=1,jlt
264 impx=fxn(i)*dt12
265 impy=fyn(i)*dt12
266 impz=fzn(i)*dt12
267 fsav1 =fsav1 +impx
268 fsav2 =fsav2 +impy
269 fsav3 =fsav3 +impz
270 fsav8 =fsav8 +abs(impx)
271 fsav9 =fsav9 +abs(impy)
272 fsav10=fsav10+abs(impz)
273 fsav11=fsav11+fni(i)*dt12
274 ENDDO
275#include "lockon.inc"
276 fsav(1)=fsav(1)+fsav1
277 fsav(2)=fsav(2)+fsav2
278 fsav(3)=fsav(3)+fsav3
279 fsav(8)=fsav(8)+fsav8
280 fsav(9)=fsav(9)+fsav9
281 fsav(10)=fsav(10)+fsav10
282 fsav(11)=fsav(11)+fsav11
283#include "lockoff.inc"
284C
285 IF(isensint(1)/=0) THEN
286 DO i=1,jlt
287 fsavparit(1,1,i+nft) = fxn(i)
288 fsavparit(1,2,i+nft) = fyn(i)
289 fsavparit(1,3,i+nft) = fzn(i)
290 ENDDO
291 ENDIF
292C---------------------------------
293 IF((anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT>0.AND.
294 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
295 . (manim>=4.AND.manim<=15).OR.h3d_data%MH3D/=0))
296 . .OR.h3d_data%N_VECT_PCONT_MAX>0)THEN
297 IF (inconv==1) THEN
298#include "lockon.inc"
299 DO i=1,jlt
300 fncont(1,ix1(i)) =fncont(1,ix1(i)) + fxn(i)*h1(i)
301 fncont(2,ix1(i)) =fncont(2,ix1(i)) + fyn(i)*h1(i)
302 fncont(3,ix1(i)) =fncont(3,ix1(i)) + fzn(i)*h1(i)
303 fncont(1,ix2(i)) =fncont(1,ix2(i)) + fxn(i)*h2(i)
304 fncont(2,ix2(i)) =fncont(2,ix2(i)) + fyn(i)*h2(i)
305 fncont(3,ix2(i)) =fncont(3,ix2(i)) + fzn(i)*h2(i)
306 fncont(1,ix3(i)) =fncont(1,ix3(i)) + fxn(i)*h3(i)
307 fncont(2,ix3(i)) =fncont(2,ix3(i)) + fyn(i)*h3(i)
308 fncont(3,ix3(i)) =fncont(3,ix3(i)) + fzn(i)*h3(i)
309 fncont(1,ix4(i)) =fncont(1,ix4(i)) + fxn(i)*h4(i)
310 fncont(2,ix4(i)) =fncont(2,ix4(i)) + fyn(i)*h4(i)
311 fncont(3,ix4(i)) =fncont(3,ix4(i)) + fzn(i)*h4(i)
312 jg = nsvg(i)
313 IF(jg>0) THEN
314C In SPMD: Treatment to be redone after reception node Remote if JG <0
315 fncont(1,jg)=fncont(1,jg)- fxn(i)
316 fncont(2,jg)=fncont(2,jg)- fyn(i)
317 fncont(3,jg)=fncont(3,jg)- fzn(i)
318 ELSE ! cas noeud remote en SPMD
319 jg = -jg
320 fnconti(nin)%P(1,jg)=fnconti(nin)%P(1,jg)-fxn(i)
321 fnconti(nin)%P(2,jg)=fnconti(nin)%P(2,jg)-fyn(i)
322 fnconti(nin)%P(3,jg)=fnconti(nin)%P(3,jg)-fzn(i)
323 ENDIF
324 ENDDO
325#include "lockoff.inc"
326 END IF !(INCONV==1) THEN
327 ENDIF
328C---------------------------------
329C NEW FRICTION MODELS
330C---------------------------------
331 IF (mfrot==0) THEN
332C--- Coulomb friction
333 DO i=1,jlt
334 xmu(i) = fric
335 ENDDO
336 ELSEIF (mfrot==1) THEN
337C--- Viscous friction
338 DO i=1,jlt
339C attention : normal <> elt normal
340 aa = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
341 v2 = (vx(i) - nx(i)*aa)**2
342 . + (vy(i) - ny(i)*aa)**2
343 . + (vz(i) - nz(i)*aa)**2
344 vv = sqrt(max(em30,v2))
345 ax1 = x3(i) - x1(i)
346 ay1 = y3(i) - y1(i)
347 az1 = x3(i) - z1(i)
348 ax2 = x4(i) - x2(i)
349 ay2 = y4(i) - y2(i)
350 az2 = x4(i) - z2(i)
351 ax = ay1*az2 - az1*ay2
352 ay = az1*ax2 - ax1*az2
353 az = ax1*ay2 - ay1*ax2
354 area = half*sqrt(ax*ax+ay*ay+az*az)
355 p = fni(i)/area
356 xmu(i) = fric + (frot_p(1) + frot_p(4)*p ) * p
357 . +(frot_p(2) + frot_p(3)*p) * vv + frot_p(5)*v2
358 xmu(i) = max(xmu(i),em30)
359 ENDDO
360 ELSEIF(mfrot==2)THEN
361C--- Loi Darmstad
362 DO i=1,jlt
363C attention : normal <> elt normal
364 aa = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
365 v2 = (vx(i) - nx(i)*aa)**2
366 . + (vy(i) - ny(i)*aa)**2
367 . + (vz(i) - nz(i)*aa)**2
368 vv = sqrt(max(em30,v2))
369 ax1 = x3(i) - x1(i)
370 ay1 = y3(i) - y1(i)
371 az1 = x3(i) - z1(i)
372 ax2 = x4(i) - x2(i)
373 ay2 = y4(i) - y2(i)
374 az2 = x4(i) - z2(i)
375 ax = ay1*az2 - az1*ay2
376 ay = az1*ax2 - ax1*az2
377 az = ax1*ay2 - ay1*ax2
378 area = half*sqrt(ax*ax+ay*ay+az*az)
379 p = fni(i)/area
380 xmu(i) = fric
381 . + frot_p(1)*exp(frot_p(2)*vv)*p*p
382 . + frot_p(3)*exp(frot_p(4)*vv)*p
383 . + frot_p(5)*exp(frot_p(6)*vv)
384 xmu(i) = max(xmu(i),em30)
385 ENDDO
386 ELSEIF (mfrot==3) THEN
387C--- Renard
388 DO i=1,jlt
389C attention : normal <> element normal
390 aa = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
391 v2 = (vx(i) - nx(i)*aa)**2
392 . + (vy(i) - ny(i)*aa)**2
393 . + (vz(i) - nz(i)*aa)**2
394 vv = sqrt(max(em30,v2))
395 IF(vv>=0.AND.vv<=frot_p(5)) THEN
396 dmu = frot_p(3)-frot_p(1)
397 vv1 = vv / frot_p(5)
398 xmu(i) = frot_p(1)+ dmu*vv1*(two-vv1)
399 ELSEIF(vv>frot_p(5).AND.vv<frot_p(6)) THEN
400 dmu = frot_p(4)-frot_p(3)
401 vv1 = (vv - frot_p(5))/(frot_p(6)-frot_p(5))
402 xmu(i) = frot_p(3)+ dmu * (three-two*vv1)*vv1**2
403 ELSE
404 dmu = frot_p(2)-frot_p(4)
405 vv2 = (vv - frot_p(6))**2
406 xmu(i) = frot_p(2) - dmu / (one + dmu*vv2)
407 ENDIF
408 xmu(i) = max(xmu(i),em30)
409 ENDDO
410 ELSEIF(mfrot==4)THEN
411C--- Exponential decay model
412 DO i=1,jlt
413 aa = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
414 v2 = (vx(i) - nx(i)*aa)**2
415 . + (vy(i) - ny(i)*aa)**2
416 . + (vz(i) - nz(i)*aa)**2
417 vv = sqrt(max(em30,v2))
418 xmu(i) = frot_p(1)
419 . + (fric-frot_p(1))*exp(-frot_p(2)*vv)
420 xmu(i) = max(xmu(i),em30)
421 ENDDO
422 ENDIF
423C------------------
424C TANGENT FORCE CALCULATION
425C------------------
426 fsav4 = zero
427 fsav5 = zero
428 fsav6 = zero
429 fsav12= zero
430 fsav13= zero
431 fsav14= zero
432 fsav15= zero
433C---------------------------------
434C INCREMENTAL (STIFFNESS) FORMULATION
435C---------------------------------
436 IF (ifq==13) THEN
437 alpha = max(one,alpha0*dt12)
438 ELSE
439 alpha = alpha0
440 ENDIF
441 DO i=1,jlt
442 fx = stif0(i)*vx(i)*dt12
443 fy = stif0(i)*vy(i)*dt12
444 fz = stif0(i)*vz(i)*dt12
445 fx = fxt(i) + alpha*fx
446 fy = fyt(i) + alpha*fy
447 fz = fzt(i) + alpha*fz
448 ftn = fx*nx(i) + fy*ny(i) + fz*nz(i)
449 fx = fx - ftn*nx(i)
450 fy = fy - ftn*ny(i)
451 fz = fz - ftn*nz(i)
452 ft = fx*fx + fy*fy + fz*fz
453 ft = max(ft,em30)
454 fn = fni(i)*fni(i)
455 beta = min(one,xmu(i)*sqrt(fn/ft))
456 fxt(i) = fx * beta
457 fyt(i) = fy * beta
458 fzt(i) = fz * beta
459 cand_fx(index(i)) = fxt(i)
460 cand_fy(index(i)) = fyt(i)
461 cand_fz(index(i)) = fzt(i)
462C------- total force
463 fxi(i)=fxn(i) + fxt(i)
464 fyi(i)=fyn(i) + fyt(i)
465 fzi(i)=fzn(i) + fzt(i)
466
467 econvt = econvt
468 . + dt1*(vx(i)*fxt(i)+vy(i)*fyt(i)+vz(i)*fzt(i))
469 ENDDO
470C---------------------------------
471C
472 IF((anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT>0.AND.
473 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
474 . (manim>=4.AND.manim<=15).OR.h3d_data%MH3D/=0))
475 . .OR.h3d_data%N_VECT_PCONT_MAX>0)THEN
476 IF (inconv==1) THEN
477#include "lockon.inc"
478 DO i=1,jlt
479 ftcont(1,ix1(i)) =ftcont(1,ix1(i)) + fxt(i)*h1(i)
480 ftcont(2,ix1(i)) =ftcont(2,ix1(i)) + fyt(i)*h1(i)
481 ftcont(3,ix1(i)) =ftcont(3,ix1(i)) + fzt(i)*h1(i)
482 ftcont(1,ix2(i)) =ftcont(1,ix2(i)) + fxt(i)*h2(i)
483 ftcont(2,ix2(i)) =ftcont(2,ix2(i)) + fyt(i)*h2(i)
484 ftcont(3,ix2(i)) =ftcont(3,ix2(i)) + fzt(i)*h2(i)
485 ftcont(1,ix3(i)) =ftcont(1,ix3(i)) + fxt(i)*h3(i)
486 ftcont(2,ix3(i)) =ftcont(2,ix3(i)) + fyt(i)*h3(i)
487 ftcont(3,ix3(i)) =ftcont(3,ix3(i)) + fzt(i)*h3(i)
488 ftcont(1,ix4(i)) =ftcont(1,ix4(i)) + fxt(i)*h4(i)
489 ftcont(2,ix4(i)) =ftcont(2,ix4(i)) + fyt(i)*h4(i)
490 ftcont(3,ix4(i)) =ftcont(3,ix4(i)) + fzt(i)*h4(i)
491 jg = nsvg(i)
492 IF(jg>0) THEN
493C In SPMD: Treatment to be redoneafter reception node Remote if JG <0
494 ftcont(1,jg)=ftcont(1,jg)- fxt(i)
495 ftcont(2,jg)=ftcont(2,jg)- fyt(i)
496 ftcont(3,jg)=ftcont(3,jg)- fzt(i)
497 ELSE ! cas noeud remote en SPMD
498 jg = -jg
499 ftconti(nin)%P(1,jg)=ftconti(nin)%P(1,jg)-fxt(i)
500 ftconti(nin)%P(2,jg)=ftconti(nin)%P(2,jg)-fyt(i)
501 ftconti(nin)%P(3,jg)=ftconti(nin)%P(3,jg)-fzt(i)
502 ENDIF
503 ENDDO
504#include "lockoff.inc"
505 END IF !(INCONV==1) THEN
506 ENDIF
507C
508 DO i=1,jlt
509 impx=fxt(i)*dt12
510 impy=fyt(i)*dt12
511 impz=fzt(i)*dt12
512 fsav4 =fsav4 +impx
513 fsav5 =fsav5 +impy
514 fsav6 =fsav6 +impz
515 impx=fxi(i)*dt12
516 impy=fyi(i)*dt12
517 impz=fzi(i)*dt12
518 fsav12=fsav12+abs(impx)
519 fsav13=fsav13+abs(impy)
520 fsav14=fsav14+abs(impz)
521 fsav15=fsav15+sqrt(impx*impx+impy*impy+impz*impz)
522 ENDDO
523#include "lockon.inc"
524 fsav(4) = fsav(4) + fsav4
525 fsav(5) = fsav(5) + fsav5
526 fsav(6) = fsav(6) + fsav6
527 fsav(12) = fsav(12) + fsav12
528 fsav(13) = fsav(13) + fsav13
529 fsav(14) = fsav(14) + fsav14
530 fsav(15) = fsav(15) + fsav15
531 fsav(26) = fsav(26) + econtt
532 fsav(27) = fsav(27) + econvt
533 fsav(28) = fsav(28) + econtdt
534#include "lockoff.inc"
535C
536 IF(isensint(1)/=0) THEN
537 DO i=1,jlt
538 fsavparit(1,4,i+nft) = fxt(i)
539 fsavparit(1,5,i+nft) = fyt(i)
540 fsavparit(1,6,i+nft) = fzt(i)
541 ENDDO
542 ENDIF
543C---------------------------------
544#include "lockon.inc"
545 IF (inconv==1) THEN
546 econtv = econtv + econvt ! Frictional Energy
547 econt = econt + econtt ! Elastic Energy
548 econtd = econtd + econtdt ! Damping Energy
549 END IF !(INCONV==1) THEN
550#include "lockoff.inc"
551C---------------------------------
552 IF(kdtint==1)THEN
553 IF(visc/=zero)THEN
554 DO i=1,jlt
555C C (i) = 2.*C (i)
556C
557 IF(msi(i)==zero)THEN
558 ks(i) =zero
559 cs(i) =zero
560 stv(i)=zero
561 ELSE
562 cx = four*c(i)*c(i)
563 cy = eight*msi(i)*kt(i)
564 aux = sqrt(cx+cy)+two*c(i)
565 stv(i)= kt(i)*aux*aux/max(cy,em30)
566 ks(i)= kt(i)
567 cs(i) =c(i)
568 ENDIF
569C
570 j1=ix1(i)
571 IF(ms(j1)==zero)THEN
572 k1(i) =zero
573 c1(i) =zero
574 st1(i)=zero
575 ELSE
576 k1(i)=kt(i)*abs(h1(i))
577 c1(i)=c(i)*abs(h1(i))
578 cx =four*c1(i)*c1(i)
579 cy =eight*ms(j1)*k1(i)
580 aux = sqrt(cx+cy)+two*c1(i)
581 st1(i)= k1(i)*aux*aux/max(cy,em30)
582 ENDIF
583C
584 j1=ix2(i)
585 IF(ms(j1)==zero)THEN
586 k2(i) =zero
587 c2(i) =zero
588 st2(i)=zero
589 ELSE
590 k2(i)=kt(i)*abs(h2(i))
591 c2(i)=c(i)*abs(h2(i))
592 cx =four*c2(i)*c2(i)
593 cy =eight*ms(j1)*k2(i)
594 aux = sqrt(cx+cy)+two*c2(i)
595 st2(i)= k2(i)*aux*aux/max(cy,em30)
596 ENDIF
597C
598 j1=ix3(i)
599 IF(ms(j1)==zero)THEN
600 k3(i) =zero
601 c3(i) =zero
602 st3(i)=zero
603 ELSE
604 k3(i)=kt(i)*abs(h3(i))
605 c3(i)=c(i)*abs(h3(i))
606 cx =four*c3(i)*c3(i)
607 cy =eight*ms(j1)*k3(i)
608 aux = sqrt(cx+cy)+two*c3(i)
609 st3(i)= k3(i)*aux*aux/max(cy,em30)
610 ENDIF
611C
612 j1=ix4(i)
613 IF(ms(j1)==zero)THEN
614 k4(i) =zero
615 c4(i) =zero
616 st4(i)=zero
617 ELSE
618 k4(i)=kt(i)*abs(h4(i))
619 c4(i)=c(i)*abs(h4(i))
620 cx =four*c4(i)*c4(i)
621 cy =eight*ms(j1)*k4(i)
622 aux = sqrt(cx+cy)+two*c4(i)
623 st4(i)= k4(i)*aux*aux/max(cy,em30)
624 ENDIF
625 ENDDO
626C
627 ELSE
628 DO i=1,jlt
629 ks(i) =stif(i)
630 cs(i) =zero
631 stv(i)=ks(i)
632 k1(i) =stif(i)*abs(h1(i))
633 c1(i) =zero
634 st1(i)=k1(i)
635 k2(i) =stif(i)*abs(h2(i))
636 c2(i) =zero
637 st2(i)=k2(i)
638 k3(i) =stif(i)*abs(h3(i))
639 c3(i) =zero
640 st3(i)=k3(i)
641 k4(i) =stif(i)*abs(h4(i))
642 c4(i) =zero
643 st4(i)=k4(i)
644 ENDDO
645 ENDIF
646 ENDIF
647C-----------------------------------------------------
648 IF(intth==0)THEN
649 DO i=1,jlt
650 fx1(i)=fxi(i)*h1(i)
651 fy1(i)=fyi(i)*h1(i)
652 fz1(i)=fzi(i)*h1(i)
653C
654 fx2(i)=fxi(i)*h2(i)
655 fy2(i)=fyi(i)*h2(i)
656 fz2(i)=fzi(i)*h2(i)
657C
658 fx3(i)=fxi(i)*h3(i)
659 fy3(i)=fyi(i)*h3(i)
660 fz3(i)=fzi(i)*h3(i)
661C
662 fx4(i)=fxi(i)*h4(i)
663 fy4(i)=fyi(i)*h4(i)
664 fz4(i)=fzi(i)*h4(i)
665C
666 ENDDO
667 END IF
668C SPMD: Identification of interf nodes.useful to send
669 IF (nspmd>1) THEN
670Ctmp+1 mic only
671#include "mic_lockon.inc"
672 DO i = 1,jlt
673 nn = nsvg(i)
674 IF(nn<0)THEN
675C temporary tag of nsvfi a -
676 nsvfi(nin)%P(-nn) = -abs(nsvfi(nin)%P(-nn))
677 ENDIF
678 ENDDO
679ctmp+1 mic only
680#include "mic_lockoff.inc"
681 ENDIF
682C-----------------------------------------------------
683 IF(idtmins==2.OR.idtmins_int/=0)THEN
684 dtmini=zero
685 dti=dt2t
686 CALL i7sms2(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
687 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
688 3 nin ,noint ,mskyi_sms, iskyi_sms,nsms ,
689 4 kt ,c ,cf ,dtmini,dti )
690 ENDIF
691C
692 IF(idtmins_int/=0)THEN
693 stif(1:jlt)=zero
694 END IF
695C-----------------------------------------------------
696 IF(iparit==3)THEN
697 IF(kdtint==0)THEN
698 CALL i7ass3(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
699 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
700 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
701 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
702 5 fxi ,fyi ,fzi ,a ,stifn)
703 ELSE
704 CALL i7ass35(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
705 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
706 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
707 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
708 5 fxi ,fyi ,fzi ,a ,stifn,viscn,
709 6 ks ,k1 ,k2 ,k3 ,k4 ,cs ,
710 7 c1 ,c2 ,c3 ,c4 )
711 ENDIF
712 ELSEIF(iparit==0)THEN
713 IF(kdtint==0)THEN
714 CALL i7ass0(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
715 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
716 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
717 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
718 5 fxi ,fyi ,fzi ,a ,stifn ,nin ,
719 6 intth ,rbid ,rbid ,rbid ,rbid ,rbid ,
720 7 rbid ,rbid ,rbid ,jtask,ibid ,ibid )
721
722 ELSE
723C
724 CALL i7ass05(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
725 2 nsvg ,h1 ,h2 ,h3 ,h4 ,
726 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
727 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
728 5 fxi ,fyi ,fzi ,a ,stifn ,viscn ,
729 6 ks ,k1 ,k2 ,k3 ,k4 ,cs ,
730 7 c1 ,c2 ,c3 ,c4 ,nin ,intth ,
731 8 rbid ,rbid ,rbid ,rbid ,rbid ,rbid ,
732 9 jtask ,rbid ,rbid ,ibid ,ibid )
733 ENDIF
734C
735 ELSE
736 IF(kdtint==0)THEN
737 CALL i7ass2(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
738 2 nsvg ,h1 ,h2 ,h3 ,h4 ,stif ,
739 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
740 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
741 5 fxi ,fyi ,fzi ,fskyi,isky ,niskyfi,
742 6 nin ,noint ,intth,rbid ,rbid ,rbid ,
743 7 rbid ,rbid ,rbid ,rbid ,rbid ,
744 a ibid ,ibid )
745 ELSE
746 CALL i7ass25(jlt ,ix1 ,ix2 ,ix3 ,ix4 ,
747 2 nsvg ,h1 ,h2 ,h3 ,h4 ,
748 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,fz2 ,
749 4 fx3 ,fy3 ,fz3 ,fx4 ,fy4 ,fz4 ,
750 5 fxi ,fyi ,fzi ,fskyi,niskyfi,nin ,
751 6 ks ,k1 ,k2 ,k3 ,k4 ,cs ,
752 7 c1 ,c2 ,c3 ,c4 ,isky ,noint ,
753 8 intth ,rbid ,rbid ,rbid ,rbid ,rbid ,
754 9 rbid ,rbid ,rbid ,ibid ,ibid )
755 ENDIF
756 ENDIF
757C
758C-----------------------------------------------------
759 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
760 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
761 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
762 IF (inconv==1) THEN
763#include "lockon.inc"
764 DO i=1,jlt
765 fcont(1,ix1(i)) =fcont(1,ix1(i)) + fx1(i)
766 fcont(2,ix1(i)) =fcont(2,ix1(i)) + fy1(i)
767 fcont(3,ix1(i)) =fcont(3,ix1(i)) + fz1(i)
768 fcont(1,ix2(i)) =fcont(1,ix2(i)) + fx2(i)
769 fcont(2,ix2(i)) =fcont(2,ix2(i)) + fy2(i)
770 fcont(3,ix2(i)) =fcont(3,ix2(i)) + fz2(i)
771 fcont(1,ix3(i)) =fcont(1,ix3(i)) + fx3(i)
772 fcont(2,ix3(i)) =fcont(2,ix3(i)) + fy3(i)
773 fcont(3,ix3(i)) =fcont(3,ix3(i)) + fz3(i)
774 fcont(1,ix4(i)) =fcont(1,ix4(i)) + fx4(i)
775 fcont(2,ix4(i)) =fcont(2,ix4(i)) + fy4(i)
776 fcont(3,ix4(i)) =fcont(3,ix4(i)) + fz4(i)
777 jg = nsvg(i)
778 IF(jg>0) THEN
779C In SPMD: Treatment to be redoen after reception node Remote if JG <0
780 fcont(1,jg)=fcont(1,jg)- fxi(i)
781 fcont(2,jg)=fcont(2,jg)- fyi(i)
782 fcont(3,jg)=fcont(3,jg)- fzi(i)
783 ENDIF
784 ENDDO
785#include "lockoff.inc"
786 END IF !(INCONV==1) THEN
787 ENDIF
788C-----------------------------------------------------
789 IF(isecin>0.AND.inconv==1)THEN
790 k0=nstrf(25)
791 IF(nstrf(1)+nstrf(2)/=0)THEN
792 DO i=1,nsect
793 nbinter=nstrf(k0+14)
794 k1s=k0+30
795 DO j=1,nbinter
796 IF(nstrf(k1s)==noint)THEN
797 IF(isecut/=0)THEN
798#include "lockon.inc"
799 DO k=1,jlt
800C attention to the signs for the accumulation of forces
801C To make it conform with CFORC3
802 IF(secfcum(4,ix1(k),i)==1.)THEN
803 secfcum(1,ix1(k),i)=secfcum(1,ix1(k),i)-fx1(k)
804 secfcum(2,ix1(k),i)=secfcum(2,ix1(k),i)-fy1(k)
805 secfcum(3,ix1(k),i)=secfcum(3,ix1(k),i)-fz1(k)
806 ENDIF
807 IF(secfcum(4,ix2(k),i)==1.)THEN
808 secfcum(1,ix2(k),i)=secfcum(1,ix2(k),i)-fx2(k)
809 secfcum(2,ix2(k),i)=secfcum(2,ix2(k),i)-fy2(k)
810 secfcum(3,ix2(k),i)=secfcum(3,ix2(k),i)-fz2(k)
811 ENDIF
812 IF(secfcum(4,ix3(k),i)==1.)THEN
813 secfcum(1,ix3(k),i)=secfcum(1,ix3(k),i)-fx3(k)
814 secfcum(2,ix3(k),i)=secfcum(2,ix3(k),i)-fy3(k)
815 secfcum(3,ix3(k),i)=secfcum(3,ix3(k),i)-fz3(k)
816 ENDIF
817 IF(secfcum(4,ix4(k),i)==1.)THEN
818 secfcum(1,ix4(k),i)=secfcum(1,ix4(k),i)-fx4(k)
819 secfcum(2,ix4(k),i)=secfcum(2,ix4(k),i)-fy4(k)
820 secfcum(3,ix4(k),i)=secfcum(3,ix4(k),i)-fz4(k)
821 ENDIF
822 jg = nsvg(k)
823 IF(jg>0) THEN
824C In SPMD: Treatment to be redone after reception node Remote if JG <0
825 IF(secfcum(4,jg,i)==1.)THEN
826 secfcum(1,jg,i)=secfcum(1,jg,i)+fxi(k)
827 secfcum(2,jg,i)=secfcum(2,jg,i)+fyi(k)
828 secfcum(3,jg,i)=secfcum(3,jg,i)+fzi(k)
829 ENDIF
830 ENDIF
831 ENDDO
832#include "lockoff.inc"
833 ENDIF
834C +fsav(section)
835 ENDIF
836 k1s=k1s+1
837 ENDDO
838 k0=nstrf(k0+24)
839 ENDDO
840 ENDIF
841 ENDIF
842C-----------------------------------------------------
843 IF((ibag/=0).OR.(idamp_rdof/=0)) THEN
844 DO i=1,jlt
845C IF(PENE(I)/=ZERO)THEN
846C modified test for coherence with SPMD communication (spmd_i7tools)
847 IF(fxi(i)/=zero.OR.fyi(i)/=zero.OR.fzi(i)/=zero)THEN
848 jg = nsvg(i)
849 IF(jg>0) THEN
850C In SPMD: Treatment to be redone after reception node Remote if JG <0
851 icontact(jg)=1
852 ENDIF
853 icontact(ix1(i))=1
854 icontact(ix2(i))=1
855 icontact(ix3(i))=1
856 icontact(ix4(i))=1
857 ENDIF
858 ENDDO
859 ENDIF
860C
861 IF(ibc==0) RETURN
862C
863 DO 400 i=1,jlt
864 IF(pene(i)==zero)GOTO 400
865 ibcm = ibc / 8
866 ibcs = ibc - 8 * ibcm
867 IF(ibcs>0) THEN
868 ig=nsvg(i)
869 IF(ig>0) THEN
870C In SPMD: Treatment to be redone after reception node Remote if JG <0
871 CALL ibcoff(ibcs,icodt(ig))
872 ENDIF
873 ENDIF
874 IF(ibcm>0) THEN
875 ig=ix1(i)
876 CALL ibcoff(ibcm,icodt(ig))
877 ig=ix2(i)
878 CALL ibcoff(ibcm,icodt(ig))
879 ig=ix3(i)
880 CALL ibcoff(ibcm,icodt(ig))
881 ig=ix4(i)
882 CALL ibcoff(ibcm,icodt(ig))
883 ENDIF
884 400 CONTINUE
885C
886 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
i7ass0
subroutine i7ass0(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, a, stifn, nin, intth, phi, fthe, phi1, phi2, phi3, phi4, condn, condint, jtask, iform, nodadt_therm)
Definition i7ass3.F:718
i7ass35
subroutine i7ass35(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, i8a, i8stifn, i8viscn, ks, k1, k2, k3, k4, cs, c1, c2, c3, c4)
Definition i7ass3.F:507
i7ass3
subroutine i7ass3(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, i8a, i8stifn)
Definition i7ass3.F:332
i7ass2
subroutine i7ass2(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, fskyi, isky, niskyfi, nin, noint, intth, phi, ftheskyi, phi1, phi2, phi3, phi4, condnskyi, condint, iform, nodadt_therm)
Definition i7ass3.F:1150
i7ass05
subroutine i7ass05(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, a, stifn, viscn, ks, k1, k2, k3, k4, cs, c1, c2, c3, c4, nin, intth, phi, fthe, phi1, phi2, phi3, phi4, jtask, condn, condint, iform, nodadt_therm)
Definition i7ass3.F:936
i7ass25
subroutine i7ass25(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, fskyi, niskyfi, nin, ks, k1, k2, k3, k4, cs, c1, c2, c3, c4, isky, noint, intth, phi, ftheskyi, phi1, phi2, phi3, phi4, condnskyi, condint, iform, nodadt_therm)
Definition i7ass3.F:1478
i7sms2
subroutine i7sms2(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, nin, noint, mskyi_sms, iskyi_sms, nsms, kt, c, cf, dtmini, dti)
Definition i7sms2.F:40
ibcoff
subroutine ibcoff(ibc, icodt)
Definition ibcoff.F:44
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:311
tri7box::fnconti
type(real_pointer2), dimension(:), allocatable fnconti
Definition tri7box.F:510
tri7box::nsvfi
type(int_pointer), dimension(:), allocatable nsvfi
Definition tri7box.F:431
tri7box::ftconti
type(real_pointer2), dimension(:), allocatable ftconti
Definition tri7box.F:510