OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r6def3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "scr14_c.inc"
#include "scr17_c.inc"
#include "units_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine r6def3 (python, skew, geo, fx, fy, fz, e, dx, dy, dz, npf, tf, off, dpx, dpy, dpz, dpx2, dpy2, dpz2, fxep, fyep, fzep, x0, y0, z0, xmom, ymom, zmom, rx, ry, rz, rpx, rpy, rpz, xmep, rmep, zmep, rpx2, rpy2, rpz2, anim, posx, posy, posz, posxx, posyy, poszz, e6, nel, al2dp, exx2, eyx2, ezx2, exy2, eyy2, ezy2, exz2, eyz2, ezz2, igeo, x0_err, aldp, yieldx, yieldy, yieldx2, yieldy2, ngl, mgn, xcr, rx1, ry1, rz1, rx2, ry2, rz2, xin, ak, xm, xkm, xcm, xkr, vx1, vx2, vy1, vy2, vz1, vz2, nuvar, uvar, dx0, dy0, dz0, rx0, ry0, rz0, fx0, fy0, fz0, xmom0, ymom0, zmom0, critnew, nft, stf, sanin, iresp, impl_s, idyna, snpc)

Function/Subroutine Documentation

◆ r6def3()

subroutine r6def3 ( type(python_), intent(inout) python,
skew,
geo,
fx,
fy,
fz,
e,
dx,
dy,
dz,
integer, dimension(snpc) npf,
tf,
off,
dpx,
dpy,
dpz,
dpx2,
dpy2,
dpz2,
fxep,
fyep,
fzep,
x0,
y0,
z0,
xmom,
ymom,
zmom,
rx,
ry,
rz,
rpx,
rpy,
rpz,
xmep,
rmep,
zmep,
rpx2,
rpy2,
rpz2,
anim,
posx,
posy,
posz,
posxx,
posyy,
poszz,
e6,
integer nel,
double precision, dimension(mvsiz) al2dp,
exx2,
eyx2,
ezx2,
exy2,
eyy2,
ezy2,
exz2,
eyz2,
ezz2,
integer, dimension(npropgi,*) igeo,
x0_err,
double precision, dimension(mvsiz) aldp,
yieldx,
yieldy,
yieldx2,
yieldy2,
integer, dimension(*) ngl,
integer, dimension(*) mgn,
xcr,
rx1,
ry1,
rz1,
rx2,
ry2,
rz2,
xin,
ak,
xm,
xkm,
xcm,
xkr,
vx1,
vx2,
vy1,
vy2,
vz1,
vz2,
integer nuvar,
target uvar,
dx0,
dy0,
dz0,
rx0,
ry0,
rz0,
fx0,
fy0,
fz0,
xmom0,
ymom0,
zmom0,
dimension(nel), intent(inout) critnew,
integer, intent(in) nft,
integer, intent(in) stf,
integer, intent(in) sanin,
integer, intent(in) iresp,
integer, intent(in) impl_s,
integer, intent(in) idyna,
integer, intent(in) snpc )
Parameters
[in]stfsize if TF
[in]saninsize of ANIM
[in]irespsingle precision flag
[in]impl_sImplicit Solver Flag
[in]idynaImplicit Solver Flag
[in]snpcSize of NPF

Definition at line 34 of file r6def3.F.

63 USE python_funct_mod
64 USE redef3_mod
65C-----------------------------------------------
66C I m p l i c i t T y p e s
67C-----------------------------------------------
68#include "implicit_f.inc"
69#include "comlock.inc"
70C-----------------------------------------------
71C G l o b a l P a r a m e t e r s
72C-----------------------------------------------
73#include "mvsiz_p.inc"
74C-----------------------------------------------
75C C o m m o n B l o c k s
76C-----------------------------------------------
77#include "param_c.inc"
78#include "com01_c.inc"
79#include "com04_c.inc"
80#include "com08_c.inc"
81#include "scr14_c.inc"
82#include "scr17_c.inc"
83#include "units_c.inc"
84C-----------------------------------------------
85C D u m m y A r g u m e n t s
86C-----------------------------------------------
87 TYPE(python_), intent(inout) :: PYTHON
88 INTEGER, INTENT(IN) :: STF !< size if TF
89 INTEGER, INTENT(IN) :: SANIN !< size of ANIM
90 INTEGER, INTENT(IN) :: IRESP !< single precision flag
91 INTEGER, INTENT(IN) :: IMPL_S !< Implicit Solver Flag
92 INTEGER, INTENT(IN) :: IDYNA !< Implicit Solver Flag
93 INTEGER, INTENT(IN) :: SNPC !< Size of NPF
94 INTEGER, INTENT(IN) :: NFT
95 INTEGER NPF(SNPC), IGEO(NPROPGI,*),NEL,NGL(*),MGN(*),NUVAR
96C REAL
97 my_real
98 . skew(lskew,*), geo(npropg,*), fx(*), fy(*), fz(*), e(*), dx(*),
99 . dy(*), dz(*), tf(stf), off(*), dpx(*), dpy(*), dpz(*), fxep(*),
100 . fyep(*), fzep(*), x0(*), y0(*), z0(*), xmom(*), ymom(*),
101 . zmom(*), rx(*), ry(*), rz(*), rpx(*), rpy(*), rpz(*), xmep(*),
102 . rmep(*), zmep(*), dpx2(*), dpy2(*), dpz2(*),rpx2(*), rpy2(*),
103 . rpz2(*),anim(sanin),posx(*),posy(*),posz(*),posxx(*),
104 . posyy(*),poszz(*),e6(nel,6),
105 . exx2(mvsiz), eyx2(mvsiz), ezx2(mvsiz),
106 . exy2(mvsiz), eyy2(mvsiz), ezy2(mvsiz),
107 . exz2(mvsiz), eyz2(mvsiz), ezz2(mvsiz),
108 . fr(mvsiz), mr(mvsiz), x0_err(mvsiz),yieldx(*),yieldy(*),
109 . yieldx2(*),yieldy2(*),xcr(mvsiz), rx1(mvsiz), rx2(mvsiz),
110 . ry1(mvsiz), ry2(mvsiz), rz1(mvsiz), rz2(mvsiz),xin(mvsiz),
111 . ak(mvsiz),xm(mvsiz),xkm(mvsiz),xcm(mvsiz),xkr(mvsiz),
112 . vx1(mvsiz),vx2(mvsiz),vy1(mvsiz),vy2(mvsiz),
113 . vz1(mvsiz),vz2(mvsiz),uvar(nuvar,*),dx0(*),dy0(*),dz0(*),
114 . rx0(*),ry0(*),rz0(*),fx0(*),fy0(*),fz0(*),xmom0(*),ymom0(*),zmom0(*)
115 DOUBLE PRECISION ALDP(MVSIZ),AL2DP(MVSIZ)
116 my_real, INTENT(INOUT) :: critnew(nel)
117 TARGET :: uvar
118C-----------------------------------------------
119C L o c a l V a r i a b l e s
120C-----------------------------------------------
121 INTEGER INDX(MVSIZ),
122 . IECROU(MVSIZ), IFUNC(MVSIZ), IFV(MVSIZ), IFUNC2(MVSIZ),
123 . I, ILENG, J, KK, IFAIL(MVSIZ),IFAIL2(MVSIZ),
124 . NINDX,IFUNC3(MVSIZ)
125C REAL
126 my_real
127 . xk(mvsiz) , yk(mvsiz),
128 . xc(mvsiz) , yc(mvsiz) ,xh(mvsiz),xhr(mvsiz),
129 . dxold(mvsiz), dyold(mvsiz), dzold(mvsiz), drold(mvsiz),
130 . b(mvsiz), d(mvsiz), epla(mvsiz),
131 . dv(mvsiz),vrt(mvsiz),vrr(mvsiz),ff(mvsiz),ee(mvsiz),
132 . dmn(mvsiz),dmx(mvsiz),xl0(mvsiz),crit(mvsiz),rmom(mvsiz),
133 . xn(mvsiz) ,dr(mvsiz),st(mvsiz),ct(mvsiz),bid(mvsiz),
134 . lscale(mvsiz),gf3(mvsiz),hx(mvsiz), hy(mvsiz), hz(mvsiz)
135 my_real
136 . at,c,cp,dt05,cc,cn,xa,xb,dlim,vfail,xka,yka,x21,y21,z21,
137 . vx21,vy21,vz21, epxy,epxz,eyzp,exzp,ryav,rzav,ryav1,rzav1,
138 . not_used,not_used2(2)
139 DOUBLE PRECISION X0DP(MVSIZ)
140 my_real ,DIMENSION(:), POINTER :: xx_old
141 TARGET :: not_used2
142C-----------------------------------------------
143C
144 not_used = zero
145 not_used2 = zero
146C
147 DO i=1,nel
148 epla(i)=zero
149 xm(i)=geo(1,mgn(i))
150 xk(i)=geo(3,mgn(i))
151 xc(i)=geo(4,mgn(i))
152 yk(i)=geo(10,mgn(i))
153 yc(i)=geo(11,mgn(i))
154 xka =geo(41,mgn(i))*xk(i)
155 yka =geo(45,mgn(i))*yk(i)
156 xkm(i)= max(xka,yka)
157 hx(i) = geo(141,mgn(i))
158 hy(i) = geo(142,mgn(i))
159
160 xh(i)= max(hx(i),hy(i))
161
162 xcm(i)= max(xc(i),yc(i))
163 xcm(i)= xcm(i)+xh(i)
164
165 xkr(i)= yka*aldp(i)*aldp(i)
166 xcr(i)= (yc(i)+ hy(i))*aldp(i)* aldp(i)
167 ENDDO
168C
169 DO i=1,nel
170 vrt(i) = geo(101,mgn(i))
171 vrr(i) = geo(102,mgn(i))
172 ifail(i) = nint(geo(79,mgn(i)))
173 ifail2(i)= nint(geo(95,mgn(i)))
174 ENDDO
175C
176 IF (inispri /= 0 .and. tt == zero) THEN
177 DO i=1,nel
178 xl0(i)= x0(i)
179! if not initialized length
180 IF (xl0(i) == zero) xl0(i) = aldp(i)
181 ENDDO
182 ENDIF
183C
184 IF (tt == zero)THEN
185 DO i=1,nel
186 x0(i)= aldp(i) ! cast double to My_real
187 ENDDO
188 ENDIF
189C
190 IF (scodver >= 101) THEN
191 IF (tt == zero)THEN
192 DO i=1,nel
193 x0_err(i)= aldp(i)-x0(i) ! difference between double and my_real
194 ENDDO
195 ENDIF
196 ENDIF
197C
198 IF ( inispri /= 0 .and. tt == zero) THEN
199 DO i=1,nel
200 x0(i)= xl0(i)
201 ENDDO
202 ENDIF
203C
204 DO i=1,nel
205 x0dp(i)= x0(i) ! cast double to my_real
206 ENDDO
207C
208 IF (scodver >= 101) THEN
209 DO i=1,nel
210 x0dp(i)= x0(i) + x0_err(i) ! difference between double and my_real
211 ENDDO
212 ENDIF
213C---------------------
214C TRANSLATIONS
215C---------------------
216 DO i=1,nel
217 dxold(i)=dx(i)
218 dyold(i)=dy(i)
219 dzold(i)=dz(i)
220 ENDDO
221!
222 IF (inispri /= 0 .and. tt == zero) THEN
223 DO i=1,nel
224 dxold(i)=dx0(i)
225 dyold(i)=dy0(i)
226 dzold(i)=dz0(i)
227 ENDDO
228 ENDIF
229C
230 dt05=half*dt1
231C
232 DO i=1,nel
233 vx21 = vx2(i)-vx1(i)
234 vy21 = vy2(i)-vy1(i)
235 vz21 = vz2(i)-vz1(i)
236C
237 epxy = (vx21*exy2(i)+vy21*eyy2(i)+vz21*ezy2(i))*dt05
238 epxz = (vx21*exz2(i)+vy21*eyz2(i)+vz21*ezz2(i))*dt05
239C
240 x21 = (rx2(i)+rx1(i))
241 y21 = (ry2(i)+ry1(i))
242 z21 = (rz2(i)+rz1(i))
243C
244 ryav1 = (x21*exy2(i)+y21*eyy2(i)+z21*ezy2(i))
245 rzav1 = (x21*exz2(i)+y21*eyz2(i)+z21*ezz2(i))
246C
247 at=epxz/max(al2dp(i),em30)
248 at=atan(at)
249 ryav = dt05 * (ryav1) + two * at
250 at=epxy/max(al2dp(i),em30)
251 at=atan(at)
252 rzav = dt05 * (rzav1) - two * at
253C
254!! DX(I) = ALDP(I) - X0(I)
255 dx(i) = aldp(i) - x0dp(i)
256 dy(i) = dyold(i) - rzav * al2dp(i)
257 dz(i) = dzold(i) + ryav * al2dp(i)
258 crit(i) = zero
259 ENDDO
260C
261 DO i=1,nel
262 ileng=nint(geo(93,mgn(i)))
263 IF (ileng /= 0) THEN
264 xl0(i)=x0(i)
265 ELSE
266 xl0(i)=one
267 ENDIF
268 ENDDO
269C
270 nindx = 0
271C---- Tension / Compression
272 DO i=1,nel
273 iecrou(i)= igeo(101,mgn(i))
274 ifunc(i) = igeo(102,mgn(i))
275 ifunc2(i)= igeo(103,mgn(i))
276 ifv(i) = igeo(104,mgn(i))
277 ifunc3(i)= igeo(119,mgn(i))
278 ak(i) = geo(41,mgn(i))
279 b(i) = geo(42,mgn(i))
280 d(i) = geo(43,mgn(i))
281 ee(i) = geo(40 ,mgn(i))
282 gf3(i) = geo(132,mgn(i))
283 ff(i) = geo(44,mgn(i))
284 lscale(i)= geo(39 ,mgn(i))
285 dmn(i) = geo(65,mgn(i))
286 dmx(i) = geo(66,mgn(i))
287 ENDDO
288C
289 IF (nuvar > 0) THEN
290 xx_old => uvar(1,1:nel)
291 ELSE
292 xx_old => not_used2
293 ENDIF
294 CALL redef3(python,
295 1 fx, xk, dx, fxep,
296 2 dxold, dpx, tf, npf,
297 3 xc, off, e6(1,1), dpx2,
298 4 anim, anim_e(11),posx,
299 5 xl0, dmn, dmx, dv,
300 6 ff, lscale, ee, gf3,
301 7 ifunc3, yieldx, x0dp, ak,
302 8 b, d, iecrou, ifunc,
303 9 ifv, ifunc2, epla, xx_old,
304 a nel, nft, stf, sanin,
305 b dt1, iresp, impl_s, idyna,
306 c snpc)
307C
308 DO i=1,nel
309 cc = geo(103,mgn(i))
310 cn = geo(109,mgn(i))
311 xa = geo(115,mgn(i))
312 xb = geo(121,mgn(i))
313 IF (off(i) == one .AND. dmx(i) /= zero .AND. dmn(i) /= zero) THEN
314 IF (ifail2(i) == 0) THEN
315 xa = one
316 xb = two
317 IF(dx(i) > zero)THEN
318 dlim = dx(i) / dmx(i)
319 ELSE
320 dlim = dx(i) / dmn(i)
321 ENDIF
322 ELSE
323 vfail = cc * (abs(dv(i)/vrt(i)))**cn
324 IF (ifail2(i) == 1) THEN
325 IF (dx(i) > zero) THEN
326 dlim = dx(i) / (dmx(i) + vfail)
327 ELSE
328 dlim = dx(i) / (dmx(i) - vfail)
329 ENDIF
330 ELSEIF (ifail2(i) == 2) THEN
331 IF (fx(i) > zero) THEN
332 dlim = fx(i) / (dmx(i) + vfail)
333 ELSE
334 dlim = fx(i) / (dmn(i) - vfail)
335 ENDIF
336 ELSEIF (ifail2(i) == 3) THEN
337 dlim = max(zero,e6(i,1)) / (dmx(i) + vfail)
338 ENDIF
339 ENDIF
340 IF (ifail(i) == 0) THEN
341C--- Uniaxial failure
342 crit(i) = max(crit(i),xa*dlim)
343 IF ((xa*dlim) > one) THEN
344 off(i)=zero
345 nindx = nindx + 1
346 indx(nindx) = i
347 idel7nok = 1
348 critnew(i) = one
349 ENDIF
350 ELSE
351C--- Multiaxial failure
352 crit(i)= crit(i) + xa * dlim**xb
353 ENDIF
354 ENDIF
355 ENDDO
356C---- Shear
357 DO i=1,nel
358 iecrou(i)= igeo(105,mgn(i))
359 ifunc(i) = igeo(106,mgn(i))
360 ifunc2(i)= igeo(107,mgn(i))
361 ifv(i) = igeo(108,mgn(i))
362 ifunc3(i)= igeo(120,mgn(i))
363 ak(i) = geo(45,mgn(i))
364 b(i) = geo(46,mgn(i))
365 d(i) = geo(47,mgn(i))
366 ee(i) = geo(180,mgn(i))
367 gf3(i) = geo(133,mgn(i))
368 ff(i) = geo(48,mgn(i))
369 lscale(i)= geo(174,mgn(i))
370 dmn(i) = geo(67,mgn(i))
371 dmx(i) = geo(68,mgn(i))
372 dr(i) = sqrt(dy(i)**2 + dz(i)**2)
373 drold(i) = sqrt(dyold(i)**2 + dzold(i)**2)
374 st(i) = zero
375 ct(i) = one
376 IF (dr(i) > zero) THEN
377 st(i) = dy(i) / dr(i)
378 ct(i) = dz(i) / dr(i)
379 ENDIF
380 fr(i) = sqrt(fy(i)**2 + fz(i)**2)
381 ENDDO
382 kk = 1 + numelr * anim_e(11)
383 IF (nuvar > 0) xx_old => uvar(2,1:nel)
384 CALL redef3(python,
385 1 fr, yk, dr, fyep,
386 2 drold, dpy, tf, npf,
387 3 yc, off, e6(1,2), dpy2,
388 4 anim(kk), anim_e(12),posy,
389 5 xl0, dmn, dmx, dv,
390 6 ff, lscale, ee, gf3,
391 7 ifunc3, yieldy, x0dp, ak,
392 8 b, d, iecrou, ifunc,
393 9 ifv, ifunc2, epla, xx_old,
394 a nel, nft, stf, sanin,
395 b dt1, iresp, impl_s, idyna,
396 c snpc)
397 DO i=1,nel
398 cc = geo(104,mgn(i))
399 cn = geo(110,mgn(i))
400 xa = geo(116,mgn(i))
401 xb = geo(122,mgn(i))
402 IF (off(i) == one .AND. dmx(i) /= zero .AND. dmn(i) /= zero) THEN
403 IF (ifail2(i) == 0) THEN
404 xa = one
405 xb = two
406 dlim = dr(i) / dmx(i)
407 ELSE
408 vfail = cc * (abs(dv(i)/vrt(i)))**cn
409 IF (ifail2(i) == 1) THEN
410 dlim = dr(i) / (dmx(i) + vfail)
411 ELSEIF (ifail2(i) == 2) THEN
412 IF (fr(i) > zero) THEN
413 dlim = fr(i) / (dmx(i) + vfail)
414 ELSE
415 dlim = fr(i) / (dmn(i) - vfail)
416 ENDIF
417 ELSEIF (ifail2(i) == 3) THEN
418 dlim = max(zero,e6(i,2)) / (dmx(i) + vfail)
419 ENDIF
420 ENDIF
421 IF (ifail(i) == 0) THEN
422C--- Uniaxial failure
423 crit(i) = max(crit(i),xa*dlim)
424 IF ((xa*dlim) > one) THEN
425 off(i)=zero
426 nindx = nindx + 1
427 indx(nindx) = i
428 idel7nok = 1
429 critnew(i) = one
430 ENDIF
431 ELSE
432C--- Multiaxial failure
433 crit(i)= crit(i) + xa * dlim**xb
434 ENDIF
435 ENDIF
436C---
437 fy(i) = fr(i)*st(i)
438 fz(i) = fr(i)*ct(i)
439 ENDDO
440C--------------------------------------------------------------
441C ROTATIONS
442C---------------------
443 DO i=1,nel
444 xin(i)= geo(9,mgn(i))
445 xk(i) = geo(19,mgn(i))
446 xc(i) = geo(20,mgn(i))
447 yk(i) = geo(23,mgn(i))
448 yc(i) = geo(24,mgn(i))
449 hx(i) = geo(143,mgn(i))
450 hy(i) = geo(144,mgn(i))
451 xhr(i)= max(hx(i),hy(i))
452
453 xkr(i)= max(xk(i)*geo(53,mgn(i)),yk(i)*geo(57,mgn(i)))+xkr(i)
454 xcr(i)= max(xc(i),yc(i))+xcr(i)+xhr(i)+xh(i)
455 ENDDO
456C
457 DO i=1,nel
458 dxold(i)=rx(i)
459 dyold(i)=ry(i)
460 dzold(i)=rz(i)
461 ENDDO
462C
463 IF ( inispri /= 0 .AND. tt == zero) THEN
464 DO i=1,nel
465 dxold(i)=rx0(i)
466 dyold(i)=ry0(i)
467 dzold(i)=rz0(i)
468 ENDDO
469 ENDIF
470C
471 DO i=1,nel
472 x21 = (rx2(i)-rx1(i))*dt1
473 y21 = (ry2(i)-ry1(i))*dt1
474 z21 = (rz2(i)-rz1(i))*dt1
475 rx(i) = dxold(i) + x21*exx2(i)+y21*eyx2(i)+z21*ezx2(i)
476 ry(i) = dyold(i) + x21*exy2(i)+y21*eyy2(i)+z21*ezy2(i)
477 rz(i) = dzold(i) + x21*exz2(i)+y21*eyz2(i)+z21*ezz2(i)
478 ENDDO
479C
480C-----Torsion
481C
482 DO i=1,nel
483 iecrou(i)= igeo(109,mgn(i))
484 ifunc(i) = igeo(110,mgn(i))
485 ifunc2(i)= igeo(111,mgn(i))
486 ifunc3(i)= igeo(121,mgn(i))
487 ifv(i) = igeo(112,mgn(i))
488 ak(i) = geo(53,mgn(i))
489 b(i) = geo(54,mgn(i))
490 d(i) = geo(55,mgn(i))
491 ee(i) = geo(182,mgn(i))
492 gf3(i) = geo(135,mgn(i))
493 ff(i) = geo(56,mgn(i))
494 lscale(i)= geo(176,mgn(i))
495 dmn(i) = geo(71,mgn(i))
496 dmx(i) = geo(72,mgn(i))
497 ENDDO
498C
499 IF (nuvar > 0) xx_old => uvar(4,1:nel)
500 CALL redef3(python,
501 1 xmom, xk, rx, xmep,
502 2 dxold, rpx, tf, npf,
503 3 xc, off, e6(1,3), rpx2,
504 4 anim, 0, posxx,
505 5 xl0, dmn, dmx, dv,
506 6 ff, lscale, ee, gf3,
507 7 ifunc3, yieldx2, x0dp, ak,
508 8 b, d, iecrou, ifunc,
509 9 ifv, ifunc2, epla, xx_old,
510 a nel, nft, stf, sanin,
511 b dt1, iresp, impl_s, idyna,
512 c snpc)
513 DO i=1,nel
514 cc = geo(105,mgn(i))
515 cn = geo(111,mgn(i))
516 xa = geo(117,mgn(i))
517 xb = geo(123,mgn(i))
518 IF (off(i) == one .AND. dmx(i)/=zero .AND. dmn(i)/=zero) THEN
519 IF (ifail2(i) == 0) THEN
520 xa = one
521 xb = two
522 IF (rx(i) > zero)THEN
523 dlim = rx(i) / dmx(i)
524 ELSE
525 dlim = rx(i) / dmn(i)
526 ENDIF
527 ELSE
528 vfail = cc * (abs(dv(i)/vrr(i)))**cn
529 IF (ifail2(i) == 1) THEN
530 IF(rx(i) > zero)THEN
531 dlim = rx(i) / (dmx(i) + vfail)
532 ELSE
533 dlim = rx(i) / (dmn(i) - vfail)
534 ENDIF
535 ELSEIF (ifail2(i) == 2) THEN
536 IF (xmom(i) > zero) THEN
537 dlim = xmom(i)/(dmx(i) + vfail)
538 ELSE
539 dlim = xmom(i)/(dmn(i) - vfail)
540 ENDIF
541 ELSEIF (ifail2(i) == 3) THEN
542 dlim = max(zero,e6(i,3)) / (dmx(i) + vfail)
543 ENDIF
544 ENDIF
545 IF (ifail(i) == 0) THEN
546C--- Uniaxial failure
547 crit(i) = max(crit(i),xa*dlim)
548 IF ((xa*dlim) > one) THEN
549 off(i)=zero
550 nindx = nindx + 1
551 indx(nindx) = i
552 idel7nok = 1
553 critnew(i) = one
554 ENDIF
555 ELSE
556C--- Multiaxial failure
557 crit(i)= crit(i) + xa * dlim**xb
558 ENDIF
559 ENDIF
560 ENDDO
561C
562C--- Radial bending
563C
564 DO i=1,nel
565 iecrou(i)= igeo(113,mgn(i))
566 ifunc(i) = igeo(114,mgn(i))
567 ifunc2(i)= igeo(115,mgn(i))
568 ifunc3(i)= igeo(122,mgn(i))
569 ifv(i) = igeo(116,mgn(i))
570 ak(i) = geo(57,mgn(i))
571 b(i) = geo(58,mgn(i))
572 d(i) = geo(59,mgn(i))
573 ee(i) = geo(183,mgn(i))
574 gf3(i) = geo(136,mgn(i))
575 ff(i) = geo(60,mgn(i))
576 lscale(i)= geo(177,mgn(i))
577 dmn(i) = geo(73,mgn(i))
578 dmx(i) = geo(74,mgn(i))
579 dr(i) = sqrt(ry(i)**2 + rz(i)**2)
580 drold(i) = sqrt(dyold(i)**2 + dzold(i)**2)
581 st(i) = zero
582 ct(i) = one
583 IF (dr(i) > zero) THEN
584 st(i) = ry(i) / dr(i)
585 ct(i) = rz(i) / dr(i)
586 ENDIF
587 rmom(i) = sqrt(ymom(i)**2 + zmom(i)**2)
588 ENDDO
589 IF (nuvar > 0) xx_old => uvar(5,1:nel)
590 CALL redef3(python,
591 1 rmom, yk, dr, rmep,
592 2 drold, rpy, tf, npf,
593 3 yc, off, e6(1,4), rpy2,
594 4 anim, 0, posyy,
595 5 xl0, dmn, dmx, dv,
596 6 ff, lscale, ee, gf3,
597 7 ifunc3, yieldy2, x0dp, ak,
598 8 b, d, iecrou, ifunc,
599 9 ifv, ifunc2, epla, xx_old,
600 a nel, nft, stf, sanin,
601 b dt1, iresp, impl_s, idyna,
602 c snpc)
603 DO i=1,nel
604 cc = geo(106,mgn(i))
605 cn = geo(112,mgn(i))
606 xa = geo(118,mgn(i))
607 xb = geo(124,mgn(i))
608 IF (off(i) == one .AND. dmx(i)/=zero .AND. dmn(i)/=zero) THEN
609 IF (ifail2(i) == 0) THEN
610 xa = one
611 xb = two
612 dlim = dr(i) / dmx(i)
613 ELSE
614 vfail = cc * (abs(dv(i)/vrr(i)))**cn
615 IF (ifail2(i) == 1) THEN
616 dlim = dr(i) / (dmx(i) + vfail)
617 ELSEIF (ifail2(i) == 2) THEN
618 IF (rmom(i) > zero) THEN
619 dlim = rmom(i)/(dmx(i) + vfail)
620 ELSE
621 dlim = rmom(i)/(dmn(i) - vfail)
622 ENDIF
623 ELSEIF (ifail2(i) == 3) THEN
624 dlim = max(zero,e6(i,4)) / (dmx(i) + vfail)
625 ENDIF
626 ENDIF
627 IF (ifail(i) == 0) THEN
628C--- Uniaxial Failure
629 crit(i) = max(crit(i),xa*dlim)
630 IF ((xa*dlim) > one) THEN
631 off(i)=zero
632 nindx = nindx + 1
633 indx(nindx) = i
634 idel7nok = 1
635 critnew(i) = one
636 ENDIF
637 ELSE
638C--- Multiaxial failure
639 crit(i)= crit(i) + xa * dlim**xb
640 ENDIF
641 ENDIF
642C
643 ymom(i) = rmom(i)*st(i)
644 zmom(i) = rmom(i)*ct(i)
645 ENDDO
646C-------------------------------
647 DO i=1,nel
648 e(i) = e6(i,1)+e6(i,2)+e6(i,3)+e6(i,4)
649 ENDDO
650C-------------------------------
651C COUPLED FAILURE
652C-------------------------------
653 DO i=1,nel
654 IF (ifail(i) == 0) THEN
655 IF (critnew(i) < one) THEN
656 critnew(i) = min(crit(i),one)
657 ELSE
658 critnew(i) = one
659 ENDIF
660 ELSEIF (ifail(i) == 1) THEN
661 IF (critnew(i) < one) THEN
662 critnew(i) = min(crit(i)/(xl0(i)*xl0(i)),one)
663 ELSE
664 critnew(i) = one
665 ENDIF
666 ENDIF
667 IF (off(i) == one .AND. ifail(i) == 1) THEN
668 IF (crit(i)/(xl0(i)*xl0(i)) > one) THEN
669 off(i)=zero
670 nindx = nindx + 1
671 indx(nindx) = i
672 idel7nok = 1
673 critnew(i) = one
674 ENDIF
675 ENDIF
676 ENDDO
677C
678 DO j=1,nindx
679 i = indx(j)
680#include "lockon.inc"
681 WRITE(iout, 1000) ngl(i)
682 WRITE(istdo,1100) ngl(i),tt
683#include "lockoff.inc"
684 ENDDO
685C-------------------------------
686C COUPLED PLASTICITY
687C-------------------------------
688 CALL repla3(
689 1 xk, rpx, tf, npf,
690 2 iecrou, ifunc, ifv, epla,
691 3 nel)
692 CALL repla3(
693 1 yk, rpy, tf, npf,
694 2 iecrou, ifunc, ifv, epla,
695 3 nel)
696C
697 DO i=1,nel
698 xk(i)=geo(3,mgn(i))
699 yk(i)=geo(10,mgn(i))
700 ENDDO
701C
702 CALL repla3(
703 1 xk, dpx, tf, npf,
704 2 iecrou, ifunc, ifv, epla,
705 3 nel)
706 CALL repla3(
707 1 yk, dpy, tf, npf,
708 2 iecrou, ifunc, ifv, epla,
709 3 nel)
710C
711 DO i=1,nel
712 xm(i) =xm(i)*xl0(i)
713 xkm(i)=xkm(i)/xl0(i)
714 xcm(i)=xcm(i)/xl0(i)
715 xin(i)=xin(i)*xl0(i)
716 xkr(i)=xkr(i)/xl0(i)
717 xcr(i)=xcr(i)/xl0(i)
718 ENDDO
719C-----------
720 1000 FORMAT(1x,'-- RUPTURE OF SPRING ELEMENT NUMBER ',i10)
721 1100 FORMAT(1x,'-- RUPTURE OF SPRING ELEMENT :',i10,' AT TIME :',g11.4)
722C-----------
723 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
repla3
subroutine repla3(xk, dpx, tf, npf, iecrou, ifunc, ifv, epla, nel)
Definition repla3.F:39