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"
#include "lockon.inc"
#include "lockoff.inc"
#include "mic_lockon.inc"
#include "mic_lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

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