OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sigeps60.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "parit_c.inc"
#include "scr17_c.inc"
#include "com01_c.inc"
#include "com08_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sigeps60 (nel, nuparam, nuvar, mfunc, kfunc, npf, tf, time, timestep, uparam, rho0, rho, volume, eint, epspxx, epspyy, epspzz, epspxy, epspyz, epspzx, depsxx, depsyy, depszz, depsxy, depsyz, depszx, epsxx, epsyy, epszz, epsxy, epsyz, epszx, sigoxx, sigoyy, sigozz, sigoxy, sigoyz, sigozx, signxx, signyy, signzz, signxy, signyz, signzx, sigvxx, sigvyy, sigvzz, sigvxy, sigvyz, sigvzx, soundsp, viscmax, uvar, off, ngl, ipt, ipm, mat, epsp, ipla, yld, pla, dpla, amu)

Function/Subroutine Documentation

◆ sigeps60()

subroutine sigeps60 ( integer nel,
integer nuparam,
integer nuvar,
integer mfunc,
integer, dimension(mfunc) kfunc,
integer, dimension(*) npf,
tf,
time,
timestep,
uparam,
rho0,
rho,
volume,
eint,
epspxx,
epspyy,
epspzz,
epspxy,
epspyz,
epspzx,
depsxx,
depsyy,
depszz,
depsxy,
depsyz,
depszx,
epsxx,
epsyy,
epszz,
epsxy,
epsyz,
epszx,
sigoxx,
sigoyy,
sigozz,
sigoxy,
sigoyz,
sigozx,
signxx,
signyy,
signzz,
signxy,
signyz,
signzx,
sigvxx,
sigvyy,
sigvzz,
sigvxy,
sigvyz,
sigvzx,
soundsp,
viscmax,
uvar,
off,
integer, dimension(nel) ngl,
integer ipt,
integer, dimension(npropmi,*) ipm,
integer, dimension(nel) mat,
epsp,
integer ipla,
yld,
pla,
dpla,
amu )

Definition at line 35 of file sigeps60.F.

48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52#include "comlock.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57C---------+---------+---+---+--------------------------------------------
58C VAR | SIZE |TYP| RW| DEFINITION
59C---------+---------+---+---+--------------------------------------------
60C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
61C NUPARAM | 1 | I | R | SIZE OF THE USER PARAMETER ARRAY
62C NUVAR | 1 | I | R | NUMBER OF USER ELEMENT VARIABLES
63C---------+---------+---+---+--------------------------------------------
64C MFUNC | 1 | I | R | NUMBER FUNCTION USED FOR THIS USER LAW not used
65C KFUNC | NFUNC | I | R | FUNCTION INDEX not used
66C NPF | * | I | R | FUNCTION ARRAY
67C TF | * | F | R | FUNCTION ARRAY
68C---------+---------+---+---+--------------------------------------------
69C TIME | 1 | F | R | CURRENT TIME
70C TIMESTEP| 1 | F | R | CURRENT TIME STEP
71C UPARAM | NUPARAM | F | R | USER MATERIAL PARAMETER ARRAY
72C RHO0 | NEL | F | R | INITIAL DENSITY
73C RHO | NEL | F | R | DENSITY
74C VOLUME | NEL | F | R | VOLUME
75C EINT | NEL | F | R | TOTAL INTERNAL ENERGY
76C EPSPXX | NEL | F | R | STRAIN RATE XX
77C EPSPYY | NEL | F | R | STRAIN RATE YY
78C ... | | | |
79C DEPSXX | NEL | F | R | STRAIN INCREMENT XX
80C DEPSYY | NEL | F | R | STRAIN INCREMENT YY
81C ... | | | |
82C EPSXX | NEL | F | R | STRAIN XX
83C EPSYY | NEL | F | R | STRAIN YY
84C ... | | | |
85C SIGOXX | NEL | F | R | OLD ELASTO PLASTIC STRESS XX
86C SIGOYY | NEL | F | R | OLD ELASTO PLASTIC STRESS YY
87C ... | | | |
88C---------+---------+---+---+--------------------------------------------
89C SIGNXX | NEL | F | W | NEW ELASTO PLASTIC STRESS XX
90C SIGNYY | NEL | F | W | NEW ELASTO PLASTIC STRESS YY
91C ... | | | |
92C SIGVXX | NEL | F | W | VISCOUS STRESS XX
93C SIGVYY | NEL | F | W | VISCOUS STRESS YY
94C ... | | | |
95C SOUNDSP | NEL | F | W | SOUND SPEED (NEEDED FOR TIME STEP)
96C VISCMAX | NEL | F | W | MAXIMUM DAMPING MODULUS(NEEDED FOR TIME STEP)
97C---------+---------+---+---+--------------------------------------------
98C UVAR |NEL*NUVAR| F |R/W| USER ELEMENT VARIABLE ARRAY
99C OFF | NEL | F |R/W| DELETED ELEMENT FLAG (=1. ON, =0. OFF)
100C---------+---------+---+---+--------------------------------------------
101#include "param_c.inc"
102#include "parit_c.inc"
103#include "scr17_c.inc"
104#include "com01_c.inc"
105#include "com08_c.inc"
106#include "units_c.inc"
107C
108 INTEGER NEL, NUPARAM, NUVAR,IPT,
109 . NGL(NEL),MAT(NEL),IPLA, IPM(NPROPMI,*)
110 my_real
111 . time,timestep,uparam(*),
112 . rho(nel),rho0(nel),volume(nel),eint(nel),
113 . epspxx(nel),epspyy(nel),epspzz(nel),
114 . epspxy(nel),epspyz(nel),epspzx(nel),
115 . depsxx(nel),depsyy(nel),depszz(nel),
116 . depsxy(nel),depsyz(nel),depszx(nel),
117 . epsxx(nel) ,epsyy(nel) ,epszz(nel) ,
118 . epsxy(nel) ,epsyz(nel) ,epszx(nel) ,
119 . sigoxx(nel),sigoyy(nel),sigozz(nel),
120 . sigoxy(nel),sigoyz(nel),sigozx(nel),
121 . epsp(nel) ,amu(nel)
122C-----------------------------------------------
123C O U T P U T A r g u m e n t s
124C-----------------------------------------------
125 my_real
126 . signxx(nel),signyy(nel),signzz(nel),
127 . signxy(nel),signyz(nel),signzx(nel),
128 . sigvxx(nel),sigvyy(nel),sigvzz(nel),
129 . sigvxy(nel),sigvyz(nel),sigvzx(nel),
130 . soundsp(nel),viscmax(nel),dpla(nel)
131C-----------------------------------------------
132C I N P U T O U T P U T A r g u m e n t s
133C-----------------------------------------------
134 my_real
135 . uvar(nel,nuvar), off(nel), yld(nel),pla(nel)
136C-----------------------------------------------
137C VARIABLES FOR FUNCTION INTERPOLATION
138C-----------------------------------------------
139 INTEGER NPF(*), MFUNC, KFUNC(MFUNC)
140 my_real
141 . finter2, tf(*),finter
142 EXTERNAL finter2,finter
143C EXTERNAL FINTER, FINTER2
144C Y = FINTER(IFUNC(J),X,NPF,TF,DYDX)
145C Y : y = f(x)
146C X : x
147C DYDX : f'(x) = dy/dx
148C IFUNC(J): FUNCTION INDEX
149C J : FIRST(J=1), SECOND(J=2) .. FUNCTION USED FOR THIS LAW
150C NPF,TF : FUNCTION PARAMETER
151C-----------------------------------------------
152C L o c a l V a r i a b l e s
153C-----------------------------------------------
154 INTEGER I,J,IADBUFV,JJ(MVSIZ),NFUNC,
155 . NRATE,IPOS1(MVSIZ),IPOS2(MVSIZ),IAD1(MVSIZ),
156 . ILEN1(MVSIZ),IAD2(MVSIZ),ILEN2(MVSIZ),
157 . IFUNC(100),NFUNCV,PFUN,
158 . IPOSP(MVSIZ),IADP(MVSIZ),ILENP(MVSIZ),NFUNCM,NRATEM,
159 . IPFLAG,IPARAM,NPAR,IPOS3(MVSIZ),IPOS4(MVSIZ),IAD3(MVSIZ),
160 . ILEN3(MVSIZ),IAD4(MVSIZ),ILEN4(MVSIZ),J1, J2, J3, J4,
161 . NINDX,INDX(MVSIZ), NN,OPTE,IFUNCE,MX
162 my_real
163 . e(mvsiz),nu,p,dav,vm,r,fac,epst,ep1,ep2,ep3,ep4,ep5,ep6,
164 . e1,e2,e3,e4,e5,e6,c,cc,d,y,yp,e42,e52,e62,epst2,
165 . c1(mvsiz),g(mvsiz),g2(mvsiz),g3(mvsiz),
166 . epsmax,rate(mvsiz,4),yfac(mvsiz,4),
167 . y1(mvsiz),y2(mvsiz),h(mvsiz),dydx1(mvsiz),
168 . dydx2(mvsiz),fail(mvsiz),epsr1,
169 . epsr2,p0(mvsiz),pfac(mvsiz),escale(mvsiz),
170 . dfdp(mvsiz),einf,ce,dydxe(mvsiz),
171 . y11, y22, y33, y44,x,
172 . x1, x2, x3, x4,y3(mvsiz),y4(mvsiz),
173 . dydx3(mvsiz),dydx4(mvsiz),pscale(mvsiz)
174C-----------------------------------------------
175C USER VARIABLES INITIALIZATION
176C-----------------------------------------------
177 IF (ivector/=1) THEN
178 mx = mat(1)
179 nfunc = ipm(10,mx)
180 DO j=1,nfunc
181 ifunc(j)=ipm(10+j,mx)
182 ENDDO
183 pfun= ifunc(nfunc-1) !! -1
184C
185 ELSE
186C ivector = 1 only
187 mx = mat(1)
188 nfuncm = 0
189 nfuncv = ipm(10,mx)
190 nfuncm = max(nfuncm,nfuncv)
191 DO j=1,nfuncm
192 IF(nfuncv>=j) THEN
193 ifunc(j)=ipm(10+j,mx)
194 ENDIF
195 ENDDO
196 pfun= ifunc(nfuncv-1) ! -1
197 ENDIF
198C
199 nratem = 0
200C
201C
202 mx = mat(1)
203 iadbufv = ipm(7,mx)-1
204 nu = uparam(iadbufv+6)
205C
206 nrate = nint(uparam(iadbufv+1))
207 nratem = max(nratem,nrate)
208
209 epsmax=uparam(iadbufv+6+2*nrate+1)
210 IF(epsmax==zero)THEN
211 IF(tf(npf(ifunc(1)+1)-1)==zero)THEN
212 epsmax=tf(npf(ifunc(1)+1)-2)
213 ELSE
214 epsmax= ep30
215 ENDIF
216 ENDIF
217c ---
218 opte = uparam(iadbufv+2*nrate+18)
219 einf = uparam(iadbufv+2*nrate+19)
220 ce = uparam(iadbufv+2*nrate+20)
221 epsr1 =uparam(iadbufv+6+2*nrate+2)
222 IF(epsr1==zero)epsr1= ep30
223 epsr2 =uparam(iadbufv+6+2*nrate+3)
224 IF(epsr2==zero)epsr2= twoep30
225 DO i=1,nel
226 e(i) = uparam(iadbufv+2)
227 g(i) = uparam(iadbufv+5)
228 g2(i) = two*g(i)
229 g3(i) = three*g(i)
230 c1(i) = e(i)/three/(one - two*nu)
231 pscale(i)= uparam(iadbufv+16+2*nrate)
232c ---
233 pla(i) = uvar(i,1)
234 ENDDO
235 IF (opte == 1)THEN
236 DO i=1,nel
237 IF(pla(i) > zero)THEN
238 ifunce = uparam(iadbufv+2*nrate+17)
239 escale(i) = finter(kfunc(ifunce),pla(i),npf,tf,dydxe(i))
240 e(i) = escale(i)* e(i)
241 g(i) = half*e(i)/(one+nu)
242 g2(i) = two*g(i)
243 g3(i) = three*g(i)
244 c1(i) =e(i)/three/(one - two*nu)
245 soundsp(i) = sqrt((c1(i) + four_over_3*g(i))/rho0(i))
246 ENDIF
247 ENDDO
248 ELSEIF ( ce /= zero) THEN
249 DO i=1,nel
250 IF(pla(i) > zero)THEN
251 e(i) = e(i)-(e(i)-einf)*(one-exp(-ce*pla(i)))
252 g(i) = half*e(i)/(one+nu)
253 g2(i) = two*g(i)
254 g3(i) = three*g(i)
255 c1(i) =e(i)/three/(one - two*nu)
256 soundsp(i) = sqrt((c1(i) + four_over_3*g(i))/rho0(i))
257 ENDIF
258 ENDDO
259 ENDIF
260C +++
261 ipflag = 0
262 DO i=1,nel
263 pfac(i) = one
264 IF (pfun>0) ipflag = ipflag + 1
265 ENDDO
266C ---
267C
268C
269 IF (isigi==0) THEN
270 IF(time==0.0)THEN
271 DO i=1,nel
272 uvar(i,1)=zero
273 uvar(i,2)=zero
274 DO j=1,nrate
275 uvar(i,j+2)=0
276 ENDDO
277 IF (pfun>0) uvar(i,nrate+5)=0
278 ENDDO
279 ENDIF
280 ENDIF
281C-----------------------------------------------
282C
283 DO i=1,nel
284C
285 pla(i) = uvar(i,1)
286 p0(i) = -(sigoxx(i)+sigoyy(i)+sigozz(i))*third
287 dav = (depsxx(i)+depsyy(i)+depszz(i))*third
288 signxx(i)=sigoxx(i)+p0(i)+g2(i)*(depsxx(i)-dav)
289 signyy(i)=sigoyy(i)+p0(i)+g2(i)*(depsyy(i)-dav)
290 signzz(i)=sigozz(i)+p0(i)+g2(i)*(depszz(i)-dav)
291 signxy(i)=sigoxy(i)+g(i) *depsxy(i)
292 signyz(i)=sigoyz(i)+g(i) *depsyz(i)
293 signzx(i)=sigozx(i)+g(i) *depszx(i)
294 pscale(i) = pscale(i)*p0(i)
295 soundsp(i) = sqrt((c1(i)+four_over_3*g(i))/rho0(i))
296 viscmax(i) = zero
297 ENDDO
298C-------------------
299C STRAIN RATE
300C-------------------
301 DO i=1,nel
302C-------------------
303C STRAIN principal 1, 4 newton iterations
304C-------------------
305 dav = (epsxx(i)+epsyy(i)+epszz(i))*third
306 e1 = epsxx(i) - dav
307 e2 = epsyy(i) - dav
308 e3 = epszz(i) - dav
309 e4 = 0.5*epsxy(i)
310 e5 = 0.5*epsyz(i)
311 e6 = 0.5*epszx(i)
312C -y = (e1-x)(e2-x)(e3-x)
313C - e5^2(e1-x) - e6^2(e2-x) - e4^2(e3-x)
314C + 2e4 e5 e6
315C e1 + e2 + e3 = 0 => terme en x^2 = 0
316C y = x^3 + c x + d
317c yp= 3 x^2 + c
318 e42 = e4*e4
319 e52 = e5*e5
320 e62 = e6*e6
321 c = - e1*e1 - e2*e2 - e3*e3 - e42 - e52 - e62
322 d = - e1*e2*e3 + e1*e52 + e2*e62 + e3*e42
323 & - two*e4*e5*e6
324 cc = c*third
325 epst = sqrt(-cc)
326 epst2 = epst * epst
327 y = (epst2 + c)* epst + d
328 IF(abs(y)>em08)THEN
329 epst = onep75 * epst
330 epst2 = epst * epst
331 y = (epst2 + c)* epst + d
332 yp = three*epst2 + c
333 IF(yp/=zero)epst = epst - y/yp
334 epst2 = epst * epst
335 y = (epst2 + c)* epst + d
336 yp = three*epst2 + c
337 IF(yp/=zero)epst = epst - y/yp
338 epst2 = epst * epst
339 y = (epst2 + c)* epst + d
340 yp = three*epst2 + c
341 IF(yp/=zero)epst = epst - y/yp
342 epst2 = epst * epst
343 y = (epst2 + c)* epst + d
344 yp = three*epst2 + c
345 IF(yp/=zero)epst = epst - y/yp
346 ENDIF
347 epst = epst + dav
348C-------------------
349C tension failure
350C-------------------
351 fail(i) = max(zero,min(one,
352 . (epsr2-epst)/(epsr2-epsr1) ))
353 ENDDO
354C-------------------
355C CRITERE
356C-------------------
357 DO i=1,nel
358 jj(i) = 1
359 ENDDO
360 IF (ivector/=1) THEN
361 DO i=1,nel
362 DO j=2,nrate-1
363 IF(epsp(i)>=uparam(iadbufv+6+j)) jj(i) = j
364 ENDDO
365 ENDDO
366C
367 ELSE
368 DO j=2,nratem-1
369 DO i=1,nel
370 IF(nrate-1>=j) THEN
371 IF(epsp(i)>=uparam(iadbufv+6+j)) jj(i) = j
372 ENDIF
373 ENDDO
374 ENDDO
375 ENDIF
376C
377 DO i=1,nel
378 IF(jj(i)==1)THEN
379 j1 = jj(i)
380 j2 = j1+1
381 j3 = j2+1
382 j4 = j3+1
383 ELSEIF(jj(i)==(nrate-1))THEN
384 j1 = jj(i) - 2
385 j2 = j1+1
386 j3 = j2+1
387 j4 = j3+1
388 ELSE
389 j1 = jj(i) - 1
390 j2 = j1+1
391 j3 = j2+1
392 j4 = j3+1
393 ENDIF
394 rate(i,1)=uparam(iadbufv + 6 + j1 )
395 rate(i,2)=uparam(iadbufv + 6 + j2 )
396 rate(i,3)=uparam(iadbufv + 6 + j3 )
397 rate(i,4)=uparam(iadbufv + 6 + j4 )
398 yfac(i,1)=uparam(iadbufv+6+nrate + j1 )
399 yfac(i,2)=uparam(iadbufv+6+nrate + j2 )
400 yfac(i,3)=uparam(iadbufv+6+nrate + j3 )
401 yfac(i,4)=uparam(iadbufv+6+nrate + j4 )
402 ENDDO
403C
404C
405
406 DO i=1,nel
407 IF(jj(i)==1)THEN
408 j1 = jj(i)
409 j2 = j1+1
410 j3 = j2+1
411 j4 = j3+1
412 ELSEIF(jj(i)==(nrate-1))THEN
413 j1 = jj(i) - 2
414 j2 = j1+1
415 j3 = j2+1
416 j4 = j3+1
417 ELSE
418 j1 = jj(i) - 1
419 j2 = j1+1
420 j3 = j2+1
421 j4 = j3+1
422 ENDIF
423 ipos1(i) = nint(uvar(i,j1+2))
424 iad1(i) = npf(ifunc(j1)) / 2 + 1
425 ilen1(i) = npf(ifunc(j1)+1) / 2 - iad1(i) - ipos1(i)
426 ipos2(i) = nint(uvar(i,j2+2))
427 iad2(i) = npf(ifunc(j2)) / 2 + 1
428 ilen2(i) = npf(ifunc(j2)+1) / 2 - iad2(i) - ipos2(i)
429 ipos3(i) = nint(uvar(i,j3+4))
430 iad3(i) = npf(ifunc(j3)) / 2 + 1
431 ilen3(i) = npf(ifunc(j3)+1) / 2 - iad3(i) - ipos3(i)
432 ipos4(i) = nint(uvar(i,j4+4))
433 iad4(i) = npf(ifunc(j4)) / 2 + 1
434 ilen4(i) = npf(ifunc(j4)+1) / 2 - iad4(i) - ipos4(i)
435 ENDDO
436C
437 CALL vinter(tf,iad1,ipos1,ilen1,nel,pla,dydx1,y1)
438 CALL vinter(tf,iad2,ipos2,ilen2,nel,pla,dydx2,y2)
439 CALL vinter(tf,iad3,ipos3,ilen3,nel,pla,dydx3,y3)
440 CALL vinter(tf,iad4,ipos4,ilen4,nel,pla,dydx4,y4)
441C
442C
443C
444C--- PRESSURE DEPENDENT YIELD FUNCTION FACTOR
445 IF (ipflag==nel.AND.(iparit==0)) THEN
446C------- to optimize in SPMD & PARIT/ON case add a global flag
447C in a case of homogeneous element groups (to do if needed)
448 DO i=1,nel
449 iposp(i) = nint(uvar(i,nrate+5))
450 iadp(i) = npf(pfun) / 2 + 1
451 ilenp(i) = npf(pfun+1) / 2 - iadp(i) - iposp(i)
452 ENDDO
453 CALL vinter2(tf,iadp,iposp,ilenp,nel,pscale,dfdp,pfac)
454 DO i=1,nel
455 uvar(i,nrate+5) = iposp(i)
456 ENDDO
457 ELSEIF (ipflag>0) THEN
458 DO i=1,nel
459 IF (pfun>0) THEN
460 iposp(i) = nint(uvar(i,nrate+5))
461 iadp(i) = npf(pfun) / 2 + 1
462 ilenp(i) = npf(pfun+1) / 2 - iadp(i)-iposp(i)
463 pfac(i) = finter2(tf ,iadp(i),iposp(i),ilenp(i),
464 . pscale(i),dfdp(i))
465 uvar(i,nrate+5) = iposp(i)
466 ENDIF
467 ENDDO
468 ENDIF
469C---
470 DO i=1,nel
471 IF(jj(i)==1)THEN
472 j1 = jj(i)
473 j2 = j1+1
474 j3 = j2+1
475 j4 = j3+1
476 dydx1(i)= dydx1(i)*yfac(i,1)
477 dydx2(i) = dydx2(i)*yfac(i,2)
478 fac = (epsp(i) - rate(i,1))/(rate(i,2) - rate(i,1))
479 h(i) = fail(i)*(dydx1(i) + fac*(dydx2(i)-dydx1(i)))
480 ELSEIF(jj(i)==(nrate-1))THEN
481 j1 = jj(i) - 2
482 j2 = j1+1
483 j3 = j2+1
484 j4 = j3+1
485 dydx3(i) = dydx3(i)*yfac(i,3)
486 dydx4(i) = dydx4(i)*yfac(i,4)
487 fac = (epsp(i) - rate(i,3))/(rate(i,4) - rate(i,3))
488 h(i) = fail(i)*(dydx3(i) + fac*(dydx4(i)-dydx3(i)))
489 ELSE
490 j1 = jj(i) - 1
491 j2 = j1+1
492 j3 = j2+1
493 j4 = j3+1
494 dydx2(i) = dydx2(i)*yfac(i,2)
495 dydx3(i) = dydx3(i)*yfac(i,3)
496 fac = (epsp(i) - rate(i,2))/(rate(i,3) - rate(i,2))
497 h(i) = fail(i)*(dydx2(i) + fac*(dydx3(i)-dydx2(i)))
498 ENDIF
499 nn = nrate
500 x1 = rate(i,1)
501 x2 = rate(i,2)
502 x3 = rate(i,3)
503 x4 = rate(i,4)
504 x = epsp(i)
505 y11 = y1(i)*yfac(i,1)
506 y22 = y2(i)*yfac(i,2)
507 y33 = y3(i)*yfac(i,3)
508 y44 = y4(i)*yfac(i,4)
509 CALL inter_rat(x1,x2,x3,x4,y11,y22,y33,y44,
510 . x,y,yp,jj(i),nn)
511 yld(i) = fail(i)*y
512Cc Y11 = DYDX1(I)*YFAC(I,1)
513Cc Y22 = DYDX2(I)*YFAC(I,2)
514Cc Y33 = DYDX3(I)*YFAC(I,3)
515Cc Y44 = DYDX4(I)*YFAC(I,4)
516Cc CALL INTER_RAT(X1,X2,X3,X4,Y11,Y22,Y33,Y44,
517Cc . X,Y,YP,JJ(I),NN)
518Cc H(I) = FAIL(I)*Y
519C
520 yld(i) = yld(i) * max(zero, pfac(i))
521 uvar(i,j1+2) = ipos1(i)
522 uvar(i,j2+2) = ipos2(i)
523 uvar(i,j3+2) = ipos3(i)
524 uvar(i,j4+2) = ipos4(i)
525 ENDDO
526C-------------------
527C PROJECTION
528C-------------------
529 IF(ipla==0)THEN
530 DO i=1,nel
531 vm =half*(signxx(i)**2+signyy(i)**2+signzz(i)**2)
532 1 +signxy(i)**2+signyz(i)**2+signzx(i)**2
533 vm =sqrt(three*vm)
534 r = min(one,yld(i)/ max(vm,em20))
535c P = C1(I) * (RHO(I)/RHO0(I) - ONE)
536 p = c1(i) * amu(i)
537 signxx(i)=signxx(i)*r-p
538 signyy(i)=signyy(i)*r-p
539 signzz(i)=signzz(i)*r-p
540 signxy(i)=signxy(i)*r
541 signyz(i)=signyz(i)*r
542 signzx(i)=signzx(i)*r
543 pla(i)=pla(i) + (one - r)*vm/max(g3(i)+h(i),em20)
544 uvar(i,1)=pla(i)
545 dpla(i) = (one - r)*vm/max(g3(i)+h(i),em20)
546 ENDDO
547 ELSEIF(ipla==2)THEN
548 DO i=1,nel
549 vm =half*(signxx(i)**2+signyy(i)**2+signzz(i)**2)
550 1 +signxy(i)**2+signyz(i)**2+signzx(i)**2
551 vm =sqrt(three*vm)
552 r = min(one,yld(i)/ max(vm,em20))
553c P = C1(I) * (RHO(I)/RHO0(I)- ONE)
554 p = c1(i) * amu(i)
555 signxx(i)=signxx(i)*r-p
556 signyy(i)=signyy(i)*r-p
557 signzz(i)=signzz(i)*r-p
558 signxy(i)=signxy(i)*r
559 signyz(i)=signyz(i)*r
560 signzx(i)=signzx(i)*r
561 pla(i)=pla(i) + (one - r)*vm/max(g3(i),em20)
562 uvar(i,1)=pla(i)
563 dpla(i) = (one - r)*vm/max(g3(i),em20)
564 ENDDO
565 ELSEIF(ipla==1)THEN
566 DO i=1,nel
567 vm =half*(signxx(i)**2+signyy(i)**2+signzz(i)**2)
568 1 +signxy(i)**2+signyz(i)**2+signzx(i)**2
569 vm =sqrt(three*vm)
570 r = min(one,yld(i)/ max(vm,em20))
571C plastic strain increment.
572 dpla(i) = (one - r)*vm/max(g3(i)+h(i),em20)
573C actual yield stress.
574 yld(i)= max(yld(i)+dpla(i)*h(i),zero)
575 r = min(one,yld(i)/ max(vm,em20))
576C
577c P = C1(I) * (RHO(I)/RHO0(I) - ONE)
578 p = c1(i) * amu(i)
579 signxx(i)=signxx(i)*r-p
580 signyy(i)=signyy(i)*r-p
581 signzz(i)=signzz(i)*r-p
582 signxy(i)=signxy(i)*r
583 signyz(i)=signyz(i)*r
584 signzx(i)=signzx(i)*r
585 pla(i)=pla(i) + dpla(i)
586 uvar(i,1)=pla(i)
587 ENDDO
588 ENDIF
589C---
590C-------------------
591
592 DO i=1,nel
593 IF(off(i)<em01) off(i)=zero
594 IF(off(i)<one) off(i)=off(i)*four_over_5
595 ENDDO
596C
597C
598C
599 nindx=0
600 DO i=1,nel
601 IF(pla(i)>epsmax.AND.off(i)==one) THEN
602 off(i)= four_over_5
603 nindx=nindx+1
604 indx(nindx)=i
605 ENDIF
606 ENDDO
607 IF(nindx>0)THEN
608 DO j=1,nindx
609#include "lockon.inc"
610 WRITE(iout, 1000) ngl(indx(j))
611 WRITE(istdo,1100) ngl(indx(j)),tt
612#include "lockoff.inc"
613 ENDDO
614 ENDIF
615
616 1000 FORMAT(1x,'RUPTURE OF SOLID ELEMENT NUMBER ',i10)
617 1100 FORMAT(1x,'RUPTURE OF SOLID ELEMENT NUMBER ',i10,
618 . ' AT TIME :',g11.4)
619C
620C
621 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
inter_rat
subroutine inter_rat(x0, x1, x2, x3, y0, y1, y2, y3, x, y, yp, i, n)
Definition sigeps60c.F:786
vinter2
subroutine vinter2(tf, iad, ipos, ilen, nel0, x, dydx, y)
Definition vinter.F:143
vinter
subroutine vinter(tf, iad, ipos, ilen, nel, x, dydx, y)
Definition vinter.F:72