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