OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sigeps02g.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| sigeps02g ../engine/source/materials/mat/mat002/sigeps02g.F
25!||--- called by ------------------------------------------------------
26!|| mulawglc ../engine/source/materials/mat_share/mulawglc.F
27!||--- uses -----------------------------------------------------
28!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
29!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.F90
30!||====================================================================
31 SUBROUTINE sigeps02g(ELBUF_STR,mat_param,
32 1 JFT ,JLT ,FOR ,MOM ,
33 2 THK ,EINT ,OFF ,DT1C ,ISRATE ,
34 3 G ,A1 ,A2 ,VOL0 ,NU ,
35 4 THK0 ,GS ,EPSP ,IOFC ,KFTS ,
36 5 NGL ,INDX ,IPLA ,IR ,IS ,
37 6 DEGMB ,DEGFX ,DEPSXX ,DEPSYY ,MX ,
38 7 DEPSXY ,DEPSYZ ,DEPSZX ,DEPBXX ,DEPBYY ,
39 8 DEPBXY ,SIGOXX ,SIGOYY ,SIGOXY ,SIGOYZ ,
40 9 SIGOZX ,MOMOXX ,MOMOYY ,MOMOXY ,SIGNXX ,
41 A SIGNYY ,SIGNXY ,SIGNYZ ,SIGNZX ,MOMNXX ,
42 B MOMNYY ,MOMNXY ,ETSE ,EXZ ,EYZ ,
43 C NEL ,IOFF_DUCT,NUVAR ,UVAR )
44!-----------------------------------------------
45! M o d u l e s
46!-----------------------------------------------
47 USE elbufdef_mod
48 use matparam_def_mod
49!-----------------------------------------------
50! I m p l i c i t T y p e s
51!-----------------------------------------------
52#include "implicit_f.inc"
53#include "comlock.inc"
54#include "parit_c.inc"
55!-----------------------------------------------
56! G l o b a l P a r a m e t e r s
57!-----------------------------------------------
58#include "mvsiz_p.inc"
59!-----------------------------------------------
60! C o m m o n B l o c k s
61!-----------------------------------------------
62#include "units_c.inc"
63#include "param_c.inc"
64#include "scr05_c.inc"
65#include "scr17_c.inc"
66#include "com08_c.inc"
67#include "impl1_c.inc"
68!-----------------------------------------------
69! D u m m y A r g u m e n t s
70!-----------------------------------------------
71 INTEGER JFT,JLT,IOFC,KFTS,IR,IS,NEL
72 INTEGER NGL(MVSIZ),INDX(MVSIZ),
73 . IOFF_DUCT(*),MX
74 INTEGER, INTENT(IN) :: NUVAR
75 my_real ,DIMENSION(NEL,NUVAR) ,INTENT(INOUT) :: UVAR
76
77 my_real
78 . FOR(NEL,5),MOM(NEL,3),EINT(JLT,2),
79 . OFF(*),DT1C(*),NU(*),G(*),A1(*),A2(*),
80 . VOL0(*),THK0(*),GS(*),EPSP(*)
81 my_real
82 . DEPSXX(NEL),DEPSYY(NEL),DEPSXY(NEL),
83 . depsyz(nel),depszx(nel),
84 . depbxx(nel),depbyy(nel),depbxy(nel),
85 . sigoxx(nel),sigoyy(nel),sigoxy(nel),
86 . sigoyz(nel),sigozx(nel),
87 . momoxx(nel),momoyy(nel),momoxy(nel),
88 . degmb(mvsiz),degfx(mvsiz),exz(*),eyz(*)
89 my_real
90 . thk(*),
91 . signxx(nel),signyy(nel),signxy(nel),
92 . momnxx(nel),momnyy(nel),momnxy(nel),
93 . signyz(nel),signzx(nel),
94 . etse(nel)
95 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
96 type (matparam_struct_) ,intent(in) :: mat_param
97!-----------------------------------------------
98! L o c a l V a r i a b l e s
99!-----------------------------------------------
100 INTEGER ICC,IPLA,IFORM,ISRATE,NINDX,INDEX(MVSIZ)
101 INTEGER I,J,N,VP,NMAX
102 my_real
103 . F1(MVSIZ),F2(MVSIZ),F3(MVSIZ),F4(MVSIZ),F5(MVSIZ),Z3,Z4,
104 . M1(MVSIZ),M2(MVSIZ),M3(MVSIZ),T(MVSIZ),EPMX,
105 . DWELM(MVSIZ),DWELF(MVSIZ),CA(MVSIZ),CB(MVSIZ),CN,
106 . YMAX(MVSIZ),UNSYEQ(MVSIZ),DWPLA(MVSIZ),
107 . hh(mvsiz),rr(mvsiz),c1,c2,c3,cc,cp,
108 . ym,epspdt(mvsiz),
109 . s1(mvsiz),s2(mvsiz),svm(mvsiz),nnu1(mvsiz),nu1(mvsiz),
110 . nu2(mvsiz),nu3(mvsiz),dpla_j(mvsiz),sm1(mvsiz),sm2(mvsiz),
111 . am(mvsiz),bm(mvsiz),anm(mvsiz),bnm(mvsiz),qtier(mvsiz),
112 . num1(mvsiz),num2(mvsiz),an(mvsiz),bn(mvsiz),
113 . gama(mvsiz),gama2(mvsiz),lfn(mvsiz),qfn(mvsiz),qfnm(mvsiz),
114 . degmb_loc(mvsiz),degsh_loc(mvsiz),degfx_loc(mvsiz),yld(mvsiz),
115 . logep(mvsiz),plap(mvsiz)
116 my_real :: dpla_i,dr,a,b,f,df,yld_i,cp1,cq1,cp2,cq2,sm3,fnm,
117 . da,db,a_i,b_i,qn,sn1,sn2,s,mm1,mm2,
118 . dfnp,dfnq,dfmp,dfmq,dfnmp,dfnmq,xp,xq,xpg,xqg,
119 . qnm1,qnm2,fnp,fnq,fmp,fmq,fnmp,fnmq,s3,aa,bb,plap1,
120 . thk12,ezz,aaa,bbb,ccc,asrate,epdr,
121 . ms,fs,d1,d2,mt,tmelt,tref,tstar,ca_1,cb_1,ymax_1
122 my_real :: dpla(mvsiz)
123 TYPE(l_bufel_) ,POINTER :: LBUF
124!-----------------------------------------------
125 DATA NMAX/2/
126!-----------------------------------------------
127 LBUF => elbuf_str%BUFLY(1)%LBUF(ir,is,1)
128!
129 iform = mat_param%iparam(1)
130 icc = mat_param%iparam(2)
131 vp = mat_param%iparam(3)
132 israte = mat_param%iparam(4)
133
134 ym = mat_param%young
135 c1 = one/ym
136 c2 =-c1*mat_param%nu
137 c3 = one/mat_param%shear
138
139 ca_1 = mat_param%uparam(1)
140 cb_1 = mat_param%uparam(2)
141 cn = mat_param%uparam(3)
142 epmx = mat_param%uparam(4)
143 ymax_1 = mat_param%uparam(5)
144 cc = mat_param%uparam(6)
145 epdr = mat_param%uparam(7)
146 z3 = mat_param%uparam(10)
147 z4 = mat_param%uparam(11)
148 asrate = mat_param%uparam(9)
149 asrate = min(one,asrate*dt1c(i))
150
151 tref = mat_param%therm%tref
152 tmelt = mat_param%therm%tmelt
153 cp = mat_param%therm%rhocp
154 IF (cp > zero) cp = one / cp
155!
156 DO i=jft,jlt
157 ca(i) = ca_1
158 cb(i) = cb_1
159 ymax(i)= ymax_1
160 etse(i) = one
161 epspdt(i) = one
162 ENDDO
163 IF (vp == 1)THEN
164 epdr = max(epdr, em20)
165 ELSE
166 epdr = max(epdr*dt1, em20)
167 ENDIF
168
169!---------------------------
170! CONTRAINTES ELASTIQUES
171!---------------------------
172 DO i=jft,jlt
173 degsh_loc(i) = for(i,4)*eyz(i)+for(i,5)*exz(i) ! shear only
174 degmb_loc(i) = degmb(i) - degsh_loc(i) ! (membrane without shear)
175 degfx_loc(i) = degfx(i) ! bending only
176!
177 f1(i) = sigoxx(i)+ a1(i)*depsxx(i)+a2(i)*depsyy(i)
178 f2(i) = sigoyy(i)+ a1(i)*depsyy(i)+a2(i)*depsxx(i)
179 f3(i) = sigoxy(i)+ g(i) *depsxy(i)
180 f4(i) = sigoyz(i) + gs(i)*depsyz(i)
181 f5(i) = sigozx(i) + gs(i)*depszx(i)
182!
183 thk12 = thk0(i)*one_over_12
184 m1(i) = momoxx(i) + (a1(i)*depbxx(i)+a2(i)*depbyy(i))*thk12
185 m2(i) = momoyy(i) + (a1(i)*depbyy(i)+a2(i)*depbxx(i))*thk12
186 m3(i) = momoxy(i) + g(i)*depbxy(i)*thk12
187!
188 ms = m1(i)+m2(i)
189 fs = f1(i)+f2(i)
190 unsyeq(i) = one/
191 . sqrt(max(sixteen*(ms*ms + three*(m3(i)*m3(i) - m1(i)*m2(i)))
192 . + fs*fs + three*(f3(i)*f3(i) - f1(i)*f2(i)),em20))
193 ENDDO
194!-------------
195! STRAIN RATE (JOHNSON-COOK, ZERILLI-ARMSTRONG)
196!-------------
197 IF (cc /= zero) THEN
198! e = 1/t integ[1/2 E (eps_m + k z)^2 dz ]
199! e = 1/2 E eps_eq^2
200! eps_eq = sqrt[ eps_m^2 + 1/12 k^2t^2 ]
201 IF(vp==1)THEN
202 DO i=jft,jlt
203 plap(i) = uvar(i,i)
204 plap(i) = max(plap(i),epdr)
205 logep(i) = log(plap(i)/epdr)
206 ENDDO
207 ELSE
208 IF (israte >= 1) THEN
209 DO i=jft,jlt
210 epspdt(i) = epsp(i)*dt1c(i)
211 epspdt(i) = max(epspdt(i),em20)
212 logep(i) = log(epspdt(i)/epdr)
213 ENDDO
214 ELSE
215 DO i=jft,jlt
216 epspdt(i) = abs(degmb_loc(i)+degfx_loc(i)*thk0(i))*unsyeq(i)
217 epspdt(i) = max(epspdt(i),em20)
218 logep(i) = log(epspdt(i)/epdr)
219 ENDDO
220 ENDIF ! IF (ISRATE >= 1)
221 ENDIF
222 DO i=jft,jlt
223 epspdt(i) = logep(i)
224 t(i) = tref + cp*(eint(i,1)+eint(i,2))/vol0(i)
225 ENDDO
226!
227 IF (iform == zero) THEN
228 DO i=jft,jlt
229 mt = max(em20,z3)
230 epspdt(i) = max(zero,epspdt(i))
231 tstar = (t(i)-tref)/(tmelt-tref)
232 IF (tstar > zero) THEN
233 epspdt(i) = (one+cc * epspdt(i))*(one-tstar**mt)
234 ELSE
235 epspdt(i) = (one+cc * epspdt(i))
236 ENDIF
237 epspdt(i) = max(em20,epspdt(i))
238 IF (icc == 1) ymax(i) = ymax(i)*epspdt(i)
239 ENDDO
240 ELSEIF (iform == 1) THEN
241 DO i=jft,jlt
242 epspdt(i) = cc*exp((-z3+z4 * epspdt(i))*t(i))
243 IF (icc == 1) ymax(i) = ymax(i) + epspdt(i)
244 ca(i) = ca(i) + epspdt(i)
245 epspdt(i) = one
246 ENDDO
247 ENDIF ! iform
248 ENDIF ! IF (CC /= ZERO)
249!---------------------------
250 IF (ipla == 0) THEN
251!---------------------------
252! RADIAL RETURN
253!---------------------------
254!-------------
255! CRITERE
256!-------------
257 DO i=jft,jlt
258 yld(i) = ca(i)+cb(i)*exp(cn * log(lbuf%PLA(i)+ em30))
259 yld(i) = min(yld(i)*epspdt(i),ymax(i))
260 rr(i) = min(one,yld(i)*unsyeq(i))
261 ENDDO
262!----------------------------
263! ETAN/E POUR COQUES ZENG
264!----------------------------
265 DO i=jft,jlt
266 IF (rr(i) < one) THEN
267 IF (yld(i) >= ymax(i)) THEN
268 hh(i) = zero
269 ELSE
270 hh(i) = cn*cb(i)*exp((cn-one)*log(lbuf%PLA(i)+em30))
271 ENDIF
272 etse(i) = hh(i)/(hh(i)+ym)
273 ENDIF
274 ENDDO
275!--------------
276! ENERGIES
277!--------------
278 DO i=jft,jlt
279 f1(i) = f1(i)*rr(i)
280 f2(i) = f2(i)*rr(i)
281 f3(i) = f3(i)*rr(i)
282 d1 = f1(i)-sigoxx(i)
283 d2 = f2(i)-sigoyy(i)
284 dwelm(i) = (f1(i)+sigoxx(i))*(c1*d1+c2*d2)+
285 . (f2(i)+sigoyy(i))*(c2*d1+c1*d2)+
286 . (f3(i)+sigoxy(i))*(c3*(f3(i)-sigoxy(i)))
287 degmb_loc(i) = degmb_loc(i)+f1(i)*depsxx(i)+f2(i)*depsyy(i)
288 . +f3(i)*depsxy(i)
289!
290 m1(i) = m1(i)*rr(i)
291 m2(i) = m2(i)*rr(i)
292 m3(i) = m3(i)*rr(i)
293 d1 = m1(i)-momoxx(i)
294 d2 = m2(i)-momoyy(i)
295 dwelf(i) = twelve*(
296 . (m1(i)+momoxx(i))*(c1*d1+c2*d2)
297 . +(m2(i)+momoyy(i))*(c2*d1+c1*d2)
298 . +(m3(i)+momoxy(i))*(c3*(m3(i)-momoxy(i))) )
299 degfx_loc(i) = degfx_loc(i)+ m1(i)*depbxx(i)+m2(i)*depbyy(i)
300 . +m3(i)*depbxy(i)
301 ENDDO
302!
303 DO i=jft,jlt
304 dwpla(i) = degmb_loc(i)+degfx_loc(i)*thk0(i)-dwelm(i)-dwelf(i)
305 ENDDO
306!-----------------------
307! EPS PLASTIQUE
308!-----------------------
309 DO i=jft,jlt
310 dpla(i) = off(i)* max(zero,half*epspdt(i)*dwpla(i)/yld(i))
311 lbuf%PLA(i) = lbuf%PLA(i) + dpla(i)
312 aaa = abs(dwelm(i)+dwelf(i))
313 bbb = max(zero,dwpla(i))
314 ccc = max(em20,aaa+bbb)
315 ezz = - (depsxx(i) + depsyy(i)) * (nu(i)*aaa/(one-nu(i)) + bbb)/ccc
316 thk(i) = thk(i) * (one + ezz*off(i))
317 ENDDO
318 IF (vp== 1) THEN
319 DO i=1,nel
320 plap1 = dpla(i)/max(em20,dt1c(i))
321 plap(i) = asrate * plap1 + (one - asrate) * plap(i)
322 ENDDO
323 ENDIF
324
325 ELSE
326!-------------------------
327! ITERATIVE
328!-------------------------
329!-------------------------
330! von mises criterion
331!-------------------------
332 DO i=jft,jlt
333 yld(i) = ca(i)+cb(i)*exp(cn * log(lbuf%PLA(i)+ em30))
334 ENDDO
335!
336 DO i=jft,jlt
337 yld(i) = min(yld(i)*epspdt(i),ymax(i))
338 ENDDO
339!
340 DO i=jft,jlt
341!-------------------------------------------------------------------------
342! GAMMA (THE INVERSE OF GAMMA IN THE FORMULA)
343!-------------------------------------------------------------------------
344 ccc = exp(-twop6666666667*lbuf%PLA(i)*ym/yld(i))
345 gama(i) = two/(three-ccc)
346 gama2(i)= gama(i)*gama(i)
347 mm1 = thirty6*gama2(i)
348 mm2 = threep4641*gama(i)
349 qtier(i) = three*gama2(i)
350 nnu1(i) = nu(i)/(one-nu(i))
351 s1(i) = (f1(i)+f2(i))*half
352 s2(i) = (f1(i)-f2(i))*half
353 s3 = f3(i)
354 sm1(i) = (m1(i)+m2(i))*half
355 sm2(i) = (m1(i)-m2(i))*half
356 sm3 = m3(i)
357 an(i) = s1(i)*s1(i)
358 bn(i) = three*(s2(i)*s2(i)+s3*s3)
359 am(i) = sm1(i)*sm1(i)*mm1
360 bm(i) = three*(sm2(i)*sm2(i)+sm3*sm3)*mm1
361 anm(i) = s1(i)*sm1(i)*mm2
362 bnm(i) = three*(s2(i)*sm2(i)+s3*sm3)*mm2
363 svm(i) = sqrt(an(i)+bn(i)+am(i)+bm(i)+abs(anm(i)+bnm(i)))
364 ezz = -(depsxx(i)+depsyy(i))*nnu1(i)
365 thk(i) = thk(i) * (one + ezz*off(i))
366 ENDDO
367!-------------------------
368! GATHER PLASTIC FLOW
369!-------------------------
370 nindx = 0
371!
372 DO i=jft,jlt
373 IF (svm(i) > yld(i) .AND. off(i) == one) THEN
374 nindx = nindx+1
375 index(nindx) = i
376 ENDIF
377 ENDDO
378!---------------------------
379! DEP EN CONTRAINTE PLANE
380!---------------------------
381 DO j=1,nindx
382 i = index(j)
383 nu1(i) = half*(one + nu(i))
384 nu2(i) = three_half *(one - nu(i))
385 nu3(i) = one - nnu1(i)
386 num1(i) = one + qtier(i)
387 num2(i) = fivep5*gama2(i)
388 lfn(i) = num2(i)
389 qfn(i) = sixteenp5*gama2(i)*gama2(i)
390 qfnm(i) = -num2(i)
391 IF (yld(i) >= ymax(i)) THEN
392 hh(i) = zero
393 ELSE
394 hh(i) = cn*cb(i)*exp((cn-one)*log(lbuf%PLA(i)+ em30))
395 ENDIF
396 etse(i) = hh(i)/(hh(i)+ym)
397 dpla_j(i) = (svm(i)-yld(i))/(three*g(i)*qtier(i)+hh(i))
398 ENDDO
399!-------------------------------
400! TAKES COUPLING INTO ACCOUNT
401!-------------------------------
402 DO n=1,nmax
403 DO j=1,nindx
404 i = index(j)
405 dpla_i = dpla_j(i)
406 yld_i = yld(i)+hh(i)*dpla_i
407 dr = a1(i)*dpla_i/yld_i
408 xp = dr*nu1(i)
409 xq = dr*nu2(i)
410 da = num1(i)+num2(i)*xp
411 db = num1(i)+num2(i)*xq
412 dfnp = lfn(i)+qfn(i)*xp
413 dfnq = lfn(i)+qfn(i)*xq
414 dfmp = onep8333*(xp+one)
415 dfmq = onep8333*(xq+one)
416 dfnmp = qfnm(i)*xp
417 dfnmq = qfnm(i)*xq
418 xp = half*xp
419 xq = half*xq
420 a = one+(da+num1(i))*xp
421 b = one+(db+num1(i))*xq
422 a_i = one/a
423 b_i = one/b
424 aa = a_i*a_i
425 bb = b_i*b_i
426 fnp = one+(dfnp+lfn(i))*xp
427 fnq = one+(dfnp+lfn(i))*xq
428 fmp = one+(dfmp+onep8333)*xp
429 fmq = one+(dfmq+onep8333)*xq
430 fnmp = one+dfnmp*xp
431 fnmq = one+dfnmq*xq
432 fnm = aa*fnmp*anm(i)+bb*fnmq*bnm(i)
433 IF (fnm < zero) THEN
434 s = -one
435 ELSE
436 s = one
437 ENDIF
438 cp1 = (fnp*an(i)+s*fnmp*anm(i)+fmp*am(i))*aa
439 cq1 = (fnq*bn(i)+s*fnmq*bnm(i)+fmq*bm(i))*bb
440 cp2 = (dfnp*an(i)+s*dfnmp*anm(i)+dfmp*am(i))*aa
441 cq2 = (dfnq*bn(i)+s*dfnmq*bnm(i)+dfmq*bm(i))*bb
442 xpg = two*nu1(i)*da*a_i
443 xqg = two*nu2(i)*db*b_i
444 f = cp1 +cq1-yld_i*yld_i
445 df =(cp2*nu1(i)+cq2*nu2(i)-cp1*xpg-cq1*xqg)*
446 . (a1(i)-dr*hh(i))/yld_i-two*hh(i)*yld_i
447 dpla_j(i) = max(zero,dpla_i-f/df)
448 ENDDO
449 ENDDO
450!------------------------------------------
451! CONTRAINTES PLASTIQUEMENT ADMISSIBLES
452!------------------------------------------
453 DO j=1,nindx
454 i = index(j)
455 lbuf%PLA(i) = lbuf%PLA(i) + dpla_j(i)
456 dpla_i = dpla_j(i)
457 yld_i = yld(i)+hh(i)*dpla_i
458 dr = a1(i)*dpla_i/yld_i
459 xp = dr*nu1(i)
460 xq = dr*nu2(i)
461 xpg = xp*xp
462 xqg = xq*xq
463 a = one+num1(i)*xp+num2(i)*xpg
464 b = one+num1(i)*xq+num2(i)*xqg
465 a_i = one/a
466 b_i = one/b
467 aa = a_i*a_i
468 bb = b_i*b_i
469 fnmp = one+qfnm(i)*xpg
470 fnmq = one+qfnm(i)*xqg
471 fnm = aa*fnmp*anm(i)+bb*fnmq*bnm(i)
472 IF (fnm < zero) THEN
473 s = -onep732*gama(i)
474 ELSE
475 s = onep732*gama(i)
476 ENDIF
477 qn = one+qtier(i)*xq
478 qnm1 = xq*s
479 qnm2 = qnm1*one_over_12
480 sn1 = (s1(i)*(one +qtier(i)*xp)-sm1(i)*s*xp)*a_i
481 sn2 = (s2(i)*qn-sm2(i)*qnm1)*b_i
482 s3 = (f3(i)*qn-m3(i)*qnm1)*b_i
483 mm1 = (sm1(i)*(one+xp)-s1(i)*s*xp*one_over_12)*a_i
484 mm2 = (sm2(i)*(one+xq)-s2(i)*qnm2)*b_i
485 m3(i) = (m3(i)*(one+xq)-f3(i)*qnm2)*b_i
486 f1(i) = sn1+sn2
487 f2(i) = sn1-sn2
488 f3(i) = s3
489 m1(i) = mm1+mm2
490 m2(i) = mm1-mm2
491 ezz = - nu3(i)*dr*sn1/ym
492 thk(i) = thk(i) * (one + ezz*off(i))
493 ENDDO
494c update and filter plastic strain rate for VP=1
495 IF (vp== 1) THEN
496 DO i=1,nel
497 plap1 = dpla_j(i)/max(em20,dt1c(i))
498 plap(i) = asrate * plap1 + (one - asrate) * plap(i)
499 ENDDO
500 ENDIF
501
502 ENDIF ! IF (IPLA == 0)
503!--------------------------------
504! ductile failure test
505!--------------------------------
506 DO i=jft,jlt
507 IF (off(i) < em01) off(i) = zero
508 IF (off(i) < one) off(i) = off(i)*four_over_5
509 ENDDO
510!
511 nindx=0
512!
513 DO i=jft,jlt
514 IF (off(i) < one) cycle
515 IF (lbuf%PLA(i) < epmx) cycle
516 off(i) = four_over_5
517 nindx = nindx+1
518 indx(nindx) = i
519 ioff_duct(i) = 1
520 ENDDO
521!
522 IF (nindx > 0) THEN
523 IF (inconv == 1) THEN
524 DO j=1,nindx
525#include "lockon.inc"
526 WRITE(iout, 1000) ngl(indx(j))
527 WRITE(istdo,1100) ngl(indx(j)),tt
528#include "lockoff.inc"
529 ENDDO
530 ENDIF ! (INCONV == 1) THEN
531 ENDIF
532!---
533 iofc = nindx
534!---
535 DO i=jft,jlt
536 signxx(i) = f1(i)
537 signyy(i) = f2(i)
538 signxy(i) = f3(i)
539 signyz(i) = f4(i)
540 signzx(i) = f5(i)
541 momnxx(i) = m1(i)
542 momnyy(i) = m2(i)
543 momnxy(i) = m3(i)
544 ENDDO
545!---
546 1000 FORMAT(1x,'-- RUPTURE OF SHELL ELEMENT NUMBER ',i10)
547 1100 FORMAT(1x,'-- RUPTURE OF SHELL ELEMENT :',i10,' AT TIME :',g11.4)
548!---
549 RETURN
550 END
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
sigeps02g
subroutine sigeps02g(elbuf_str, mat_param, jft, jlt, for, mom, thk, eint, off, dt1c, israte, g, a1, a2, vol0, nu, thk0, gs, epsp, iofc, kfts, ngl, indx, ipla, ir, is, degmb, degfx, depsxx, depsyy, mx, depsxy, depsyz, depszx, depbxx, depbyy, depbxy, sigoxx, sigoyy, sigoxy, sigoyz, sigozx, momoxx, momoyy, momoxy, signxx, signyy, signxy, signyz, signzx, momnxx, momnyy, momnxy, etse, exz, eyz, nel, ioff_duct, nuvar, uvar)
Definition sigeps02g.F:44