29 1 NEL ,NGL ,NUPARAM ,NUVAR ,VOLUME ,FHEAT ,
30 2 TIME ,TIMESTEP,UPARAM ,UVAR ,JTHE ,OFF ,
31 3 RHO0 ,RHO ,PLA ,DPLA ,EPSD ,SOUNDSP ,
32 4 DEPSXX ,DEPSYY ,DEPSZZ ,DEPSXY ,DEPSYZ ,DEPSZX ,
33 5 SIGOXX ,SIGOYY ,SIGOZZ ,SIGOXY ,SIGOYZ ,SIGOZX ,
34 6 SIGNXX ,SIGNYY ,SIGNZZ ,SIGNXY ,SIGNYZ ,SIGNZX ,
35 7 SIGY ,ET ,DPLA_NL ,DMG ,TEMP ,JLAG ,
36 8 SEQ ,PLA_NL ,L_PLANL ,PLAP_NL ,L_EPSDNL)
40#include "implicit_f.inc"
48 INTEGER NEL,NUPARAM,NUVAR,JTHE
49 INTEGER ,
INTENT(IN) :: JLAG
50 INTEGER ,
DIMENSION(NEL)INTENT(IN)
51INTEGER ,
INTENT(IN) :: L_PLANL,L_EPSDNL
54 my_real,
DIMENSION(NUPARAM),
INTENT(IN) ::
56 my_real,
DIMENSION(NEL),
INTENT(IN) ::
58 . depsxx,depsyy,depszz,depsxy,depsyz,depszx,
59 . sigoxx,sigoyy,sigozz,sigoxy,sigoyz,sigozx
60 my_real,
DIMENSION(NEL*L_PLANL),
INTENT(IN) ::
62 my_real,
DIMENSION(NEL*L_EPSDNL),
INTENT(IN) ::
64 my_real,
DIMENSION(NEL),
INTENT(IN) :: volume
65 my_real ,
DIMENSION(NEL),
INTENT(INOUT) :: fheat
67 my_real ,
DIMENSION(NEL),
INTENT(OUT) ::
69 . signxx,signyy,signzz,signxy,signyz,signzx
71 my_real ,
DIMENSION(NEL),
INTENT(INOUT) ::
72 . pla,dpla,epsd,off,temp,seq
73 my_real ,
DIMENSION(NEL,6),
INTENT(INOUT) ::
75 my_real ,
DIMENSION(NEL,NUVAR),
INTENT(INOUT) ::
80 INTEGER I,K,II,IGURSON,NINDX,INDEX(NEL),NICE
83 . young,bulk,lam,g,g2,nu,cdr,kdr,hard,yld0,qvoce,bvoce,jcc,
84 . epsp0,mtemp,tini,tref,eta,cp,dpis,dpad,asrate,afiltr,hkhi,
85 . q1,q2,ed,an,epn,kw,fr,fc,f0,normsig,dti
87 . h,ldav,trdep,trdfds,sigvm,sigdr2,yld2i,omega,
88 . dtemp,fcosh,fsinh,dpdt,dlam,ddep
90 . dpxx,dpyy,dpzz,dpxy,dpyz,dpzx,dsdrdj2,dsdrdj3,
91 . dj3dsxx,dj3dsyy,dj3dszz,dj3dsxy,dj3dsyz,dj3dszx,
92 . dj2dsxx,dj2dsyy,dj2dszz,dj2dsxy,dj2dsyz,dj2dszx,
93 . dfdsxx,dfdsyy,dfdszz,dfdsxy,dfdsyz,dfdszx,
94 . normxx,normyy,normzz,normxy,normyz,normzx,
95 . denom,dphi,sdpla,dphi_dtrsig,sdv_dfdsig,sig_dfdsig,dfdsig2,
96 . dphi_dsig,dphi_dyld,dphi_dfdr,dphi_dfs,dfs_dft,
97 . dfn_dlam,dfsh_dlam,dfg_dlam,dft_dlam,dfdpla,dyld_dpla_nl,
98 . dfn,dfsh,dfg,dft,dyld_dpla,dyld_dtemp,dtemp_dlam
100 my_real,
DIMENSION(NEL) ::
101 . dsigxx,dsigyy,dsigzz,dsigxy,dsigyz,dsigzx,trsig,
102 . sxx,syy,szz,sxy,syz,szx,sigm,j2,j3,sigdr,yld,weitemp,
103 . hardp,fhard,frate,ftherm,fdr,depxx,depyy,depzz,depxy,depyz,depzx,
104 . fdam,phi0,phi,ft,fs,fg,fn,fsh,dpla_dlam,triax,etat
125 nice = nint(uparam(11))
145 afiltr = asrate*timestep/(asrate*timestep + one)
146 dti = one /
max(timestep, em20
148 igurson = nint(uparam(30))
166 IF (off(i) < em03) off(i) = zero
167 IF (off(i) < one) off(i) = off(i)*four_over_5
171 fg(i) = dmg(i,2) ! growth damage
183 IF (time == zero)
THEN
184 IF (jthe == 0) temp(1:nel) = tini
192 dmg(1:nel,6) = fc + (one/q1-fc)*(f0-fc)/(fr-fc)
194 fs(1:nel) = dmg(1:nel,6)
197 IF (cp > zero .OR. jthe /= 0)
THEN
200 IF (epsd(i) < dpis)
THEN
202 ELSEIF (epsd(i) > dpad)
THEN
205 weitemp(i) = ((epsd(i)-dpis)**2 )
206 . * (three*dpad - two*epsd(i) - dpis)
215 fhard(i) = yld0 + hard*pla(i) + qvoce*(one-exp(-bvoce*pla(i)))
216 IF (igurson == 2)
THEN
217 IF (pla_nl(i) - pla(i) < zero)
THEN
218 fhard(i) = fhard(i) - hkhi*(pla_nl(i) - pla(i))
223 IF (epsd(i) > epsp0) frate(i) = frate(i) + jcc*log(epsd(i)/epsp0
225 ftherm(i) = one - mtemp*(temp(i) - tref)
227 yld(i) = fhard(i)*frate(i)*ftherm(i)
229 yld(i) =
max(em10, yld(i))
238 ldav = (depsxx(i) + depsyy(i) + depszz(i)) * lam
239 signxx(i) = sigoxx(i) + (depsxx(i)*g2 + ldav)
240 signyy(i) = sigoyy(i) + (depsyy(i)*g2 + ldav)
241 signzz(i) = sigozz(i) + (depszz(i)*g2 + ldav)
242 signxy(i) = sigoxy(i) + depsxy(i)*g
243 signyz(i) = sigoyz(i) + depsyz(i)*g
244 signzx(i) = sigozx(i) + depszx(i)*g
246 trsig(i) = signxx(i) + signyy(i) + signzz(i)
247 sigm(i) = -trsig(i) * third
249 sxx(i) = signxx(i) + sigm(i)
250 syy(i) = signyy(i) + sigm(i)
251 szz(i) = signzz(i) + sigm(i)
256 j2(i) = half*(sxx(i)**2 + syy(i)**2 + szz(i)**2 )
257 . + sxy(i)**2 + syz(i)**2 + szx(i)**2
259 j3(i) = sxx(i) * syy(i) * szz(i)
260 . + sxy(i) * syz(i) * szx(i) * two
261 . - sxx(i) * syz(i)**2
262 . - syy(i) * szx(i)**2
263 . - szz(i) * sxy(i)**2
265 fdr(i) = j2(i)**3 - cdr*(j3(i)**2)
266 ! checking equivalent stress values
267 IF (fdr(i) > zero)
THEN
273 IF (sigdr(i)>zero)
THEN
274 triax(i) = (trsig(i)*third)/sigdr(i)
278 IF (trsig(i)<zero)
THEN
289 fdam(i) = two*q1*fs(i)*cosh(q2*etat(i)*trsig(i)/yld(i)/two) - (q1*fs(i))**2
290 phi(i) = (sigdr(i) / yld(i))**2 - one + fdam(i)
296 IF ((phi(i) >= zero).AND.(off(i) == one).AND.(ft(i) < fr))
THEN
305#include "vectorize.inc"
312 ldav = (depsxx(i) + depsyy(i) + depszz(i)) * lam
313 dsigxx(i) = depsxx(i)*g2 + ldav
314 dsigyy(i) = depsyy(i)*g2 + ldav
315 dsigzz(i) = depszz(i)*g2 + ldav
316 dsigxy(i) = depsxy(i)*g
317 dsigyz(i) = depsyz(i)*g
318 dsigzx(i) = depszx(i)*g
322 trsig(i) = sigoxx(i) + sigoyy(i) + sigozz(i)
323 sigm(i) = -trsig(i) * third
324 sxx(i) = sigoxx(i) + sigm(i)
325 syy(i) = sigoyy(i) + sigm(i)
326 szz(i) = sigozz(i) + sigm(i)
330 j2(i) = half*(sxx(i)**2 + syy(i)**2 + szz(i)**2 )
331 . + sxy(i)**2 + syz(i)**2 + szx(i)*
332 j3(i) = sxx(i)*syy(i)*szz(i) + sxy(i)*syz(i)*szx(i) * two
333 . - sxx(i)*syz(i)**2 - syy(i)*szx(i)**2 - szz(i)*sxy(i)**2
334 fdr(i) = j2(i)**3 - cdr*(j3(i)**2)
335 sigdr(i) = kdr * exp((one/six)*log(fdr(i)))
337 triax(i) = (trsig(i)*third)/sigdr(i)
338 IF (trsig(i)<zero)
THEN
358 yld2i = one/(yld(i)**2)
359 dphi_dsig = two*sigdr(i)*yld2i
360 fsinh = sinh(q2*etat(i)*trsig(i)/(yld(i)*two))
361 dphi_dtrsig = q1*q2*etat(i)*fs(i)*fsinh/yld(i)
364 normsig = sqrt(sigoxx(i)*sigoxx(i)
365 . + sigoyy(i)*sigoyy(i)
366 . + sigozz(i)*sigozz(i)
367 . + two*sigoxy(i)*sigoxy(i)
368 . + two*sigoyz(i)*sigoyz(i)
369 . + two*sigozx(i)*sigozx(i))
370 normsig =
max(normsig,one)
373 fdr(i) = (j2(i)/(normsig**2))**3 - cdr*((j3(i)/(normsig**3))**2)
374 dphi_dfdr = dphi_dsig*kdr*(one/six)*exp(-(five
375 dsdrdj2 = dphi_dfdr*three*(j2(i)/(normsig**2))**2
376 dsdrdj3 = -dphi_dfdr*two*cdr*(j3(i)/(normsig**3))
378 dj3dsxx = two_third*(syy(i)*szz(i)-syz(i)**2)/(normsig**2)
379 . - third*(sxx(i)*szz(i)-szx(i)**2)/(normsig
380 . - third*(sxx(i)*syy(i)-sxy(i)**2)/(normsig**2)
381 dj3dsyy = - third*(syy(i)*szz(i)-syz(i)**2)/(normsig
382 . + two_third*(sxx(i)*szz(i)-szx(i)**2)/(normsig**2)
383 . - third*(sxx(i)*syy(i)-sxy(i)**2)/(normsig**2)
384 dj3dszz = - third*(syy(i)*szz(i)-syz(i)**2)/(normsig**2)
385 . - third*(sxx(i)*szz(i)-szx(i)**2)/(normsig**2)
386 . + two_third*(sxx(i)*syy(i)-sxy(i)**2)/(normsig**2)
387 dj3dsxy = two*(sxx(i)*sxy(i) + sxy(i)*syy(i) + szx(i)*syz(i))/(normsig**2)
388 dj3dsyz = two*(sxy(i)*szx(i) + syy(i)*syz(i) + syz(i)*szz(i))/(normsig**2)
389 dj3dszx = two*(sxx(i)*szx(i) + sxy(i)*syz(i) + szx
391 normxx = dsdrdj2*sxx(i)/normsig + dsdrdj3*dj3dsxx + dphi_dtrsig
392 normyy = dsdrdj2*syy(i)/normsig + dsdrdj3*dj3dsyy + dphi_dtrsig
393 normzz = dsdrdj2*szz(i)/normsig + dsdrdj3*dj3dszz + dphi_dtrsig
394 normxy = two*dsdrdj2*sxy(i)/normsig + dsdrdj3*dj3dsxy
395 normyz = two*dsdrdj2*syz(i)/normsig + dsdrdj3*dj3dsyz
396 normzx = two*dsdrdj2*szx(i)/normsig + dsdrdj3*dj3dszx
402 dphi = normxx * dsigxx(i)
403 . + normyy * dsigyy(i)
404 . + normzz * dsigzz(i)
405 . + normxy * dsigxy(i)
406 . + normyz * dsigyz(i)
407 . + normzx * dsigzx(i)
413 trdfds = normxx + normyy + normzz
414 dfdsig2 = normxx *(normxx*g2 + lam*trdfds)
415 . + normyy *(normyy*g2 + lam*trdfds)
416 . + normzz *(normzz*g2 + lam*trdfds)
426 hardp(i) = hard + qvoce*bvoce*exp(-bvoce*pla(i))
427 IF (igurson == 2)
THEN
428 IF (pla_nl(i) - pla(i) < zero)
THEN
429 hardp(i) = hardp(i) + hkhi
432 dyld_dpla = hardp(i)*frate(i)*ftherm(i)
434 IF (igurson == 2)
THEN
435 IF (pla_nl(i) - pla(i) < zero)
THEN
436 dyld_dpla_nl = -hkhi*frate(i)*ftherm(i)
444 sdv_dfdsig = sxx(i) * normxx
450 sig_dfdsig = sigoxx(i) * normxx
451 . + sigoyy(i) * normyy
452 . + sigozz(i) * normzz
453 . + sigoxy(i) * normxy
454 . + sigoyz(i) * normyz
455 . + sigozx(i) * normzx
456 dpla_dlam(i) = sig_dfdsig / ((one - ft(i))*yld(i))
460 IF (jthe == 0 .and. cp > zero)
THEN
463 dyld_dtemp = -fhard(i)*frate(i)*mtemp
466 dtemp_dlam = weitemp(i)*(eta/(rho0(i)*cp))*sig_dfdsig
475 dphi_dyld = -two*sigdr2/yld(i)**3-dphi_dtrsig*trsig
481 fcosh = cosh(q2*etat(i)*trsig(i)/(yld(i)*two))
482 dphi_dfs = two*q1*fcosh - two*q1*q1*fs(i)
486 IF (ft(i) >= fc)
THEN
487 dfs_dft = ((one/q1)-fc)*(fr-fc)
494 IF ((pla(i)>=ed).AND.(ft(i)<fr))
THEN
496 IF (triax(i)>=zero)
THEN
497 dfn_dlam = an*dpla_dlam(i)
499 ELSEIF ((triax(i)<zero).AND.(triax(i)>=-third))
THEN
500 dfn_dlam = an*
max(one + three*triax(i),zero)*dpla_dlam(i)
511 IF ((sigdr(i) > zero).AND.(ft(i)>zero).AND.(ft(i)<fr))
THEN
512 sigvm = sqrt(
max(em20, three*(j2(i)/(normsig**2))))
513 omega = one - ((twenty7 *(j3(i)/(normsig**3)))/(two*sigvm**3))**2
514 omega =
max(zero,omega)
515 omega =
min(one,omega)
516 dfsh_dlam = kw*omega*ft(i)*sdv_dfdsig/sigdr(i)
523 IF ((ft(i)>zero).AND.(ft(i)<fr).AND.(trdfds
THEN
524 dfg_dlam = (one-ft(i))*trdfds
531 dft_dlam = dfn_dlam + dfg_dlam + dfsh_dlam
534 denom = dfdsig2 - (dphi_dyld * dyld_dpla * dpla_dlam(i))
535 . - dphi_dfs * dfs_dft * dft_dlam
536 IF (jthe == 0 .and. cp > zero)
THEN
537 denom = denom - dphi_dyld * dyld_dtemp * dtemp_dlam
539 denom = sign(
max(abs(denom),em20) ,denom)
545 IF (igurson == 2)
THEN
546 dphi = dphi + dphi_dyld*dyld_dpla_nl*dpla_nl(i)
548 dlam = (dphi + phi(i)) / denom
549 dlam =
max(dlam, zero)
558 trdep = dpxx + dpyy + dpzz
561 ddep = (dlam/((one - ft(i))*yld(i)))*sig_dfdsig
562 dpla(i) = dpla(i) + ddep
563 pla(i) = pla(i) + ddep
567 IF ((ft(i)>zero).AND.(ft(i)<fr).AND.(trdep
THEN
568 fg(i) = fg(i) + (one-ft(i))*trdep
570 fg(i) =
max(fg(i),zero)
572 IF ((pla(i) >= ed).AND.(ft(i)<fr))
THEN
574 IF (triax(i)>=zero)
THEN
575 fn(i) = fn(i) + an*ddep
577 ELSEIF ((triax(i)<zero).AND.(triax(i)>=-third))
THEN
578 fn(i) = fn(i) + an*
max(one + three*triax(i),zero)*ddep
581 fn(i) =
max(fn(i),zero)
583 IF ((sigdr(i) > zero).AND.(ft(i)>zero).AND.(ft(i)<fr))
THEN
584 sigvm = sqrt(
max(em20, three*(j2(i)/(normsig**2))))
585 omega = one - ((twenty7 *(j3(i)/(normsig**3)))/(two*sigvm**3))**2
586 omega =
max(zero,omega)
587 omega =
min(one,omega)
588 sdpla = sxx(i)*dpxx + syy(i)*dpyy + szz(i)*dpzz
589 . + sxy(i)*dpxy + syz(i)*dpyz + szx(i)*dpzx
590 fsh(i) = fsh(i) + kw*omega*ft(i)*(sdpla/sigdr(i))
592 fsh(i) =
max(fsh(i),zero)
594 ft(i) = f0 + fg(i) + fn(i) + fsh(i)
595 ft(i) =
min(ft(i),fr)
600 fs(i) = fc + (one/q1 - fc) * (ft(i)-fc)/(fr-fc)
602 fs(i) =
min(fs(i),one/q1)
605 IF (jthe == 0 .AND. cp > zero )
THEN
606 dtemp = weitemp(i)*yld(i)*(one-ft(i))*ddep*eta/(rho0(i)*cp)
607 temp(i) = temp(i) + dtemp
609 ftherm(i) = one - mtemp*(temp(i) - tref)
612 fhard(i) = yld0 + hard * pla(i) + qvoce*(one-exp(-bvoce*pla(i)))
613 IF (igurson == 2)
THEN
614 IF (pla_nl(i) - pla(i) < zero)
THEN
615 fhard(i) = fhard(i) - hkhi*(pla_nl(i) - pla(i))
620 yld(i) = fhard(i) * frate(i) * ftherm(i)
621 yld(i) =
max(yld(i), em10)
625 signxx(i) = sigoxx(i) + dsigxx(i) - (dpxx*g2 + ldav)
626 signyy(i) = sigoyy(i) + dsigyy(i) - (dpyy*g2 + ldav)
627 signzz(i) = sigozz(i) + dsigzz(i) - (dpzz*g2 + ldav)
628 signxy(i) = sigoxy(i) + dsigxy(i) - dpxy*g
631 trsig(i) = signxx(i) + signyy(i) + signzz(i)
632 sigm(i) = -trsig(i) * third
633 sxx(i) = signxx(i) + sigm(i)
634 syy(i) = signyy(i) + sigm(i)
635 szz(i) = signzz(i) + sigm(i)
641 j2(i) = half*(sxx(i)**2 + syy(i)**2 + szz(i)**2 )
642 . + sxy(i)**2 + syz(i)**2 + szx(i)**2
643 j3(i) = sxx(i) * syy(i) * szz(i) + two * sxy(i) * syz(i) * szx(i)
644 . - sxx(i) * syz(i)**2 - syy(i) * szx(i)**2 - szz(i) * sxy(i)**2
645 fdr(i) = j2(i)**3 - cdr*(j3(i)**2)
646 sigdr(i) = kdr * exp((one/six)*log(fdr(i)))
648 triax(i) = (trsig(i)*third)/sigdr(i)
649 IF (trsig(i)<zero)
THEN
657 yld2i = one / yld(i)**2
658 fcosh = cosh(q2*etat(i)*trsig(i)/(yld(i)*two))
659 fdam(i) = two*q1*fs(i)*fcosh - (q1*fs(i))**2
660 phi(i) = sigdr2 * yld2i - one + fdam(i)
664 !===================================================================
669 IF (dpla(i) > zero)
THEN
671 et(i) = hardp(i)*frate(i) / (hardp(i)*frate(i) + young)
681 dmg(i,5) =
min(ft(i),fr)
682 dmg(i,6) =
min(fs(i),one/q1)
685 IF (ft(i) >= fr)
THEN
686 IF (off(i) == one) off(i) = four_over_5
697 dpdt = dpla(i) /
max(em20,timestep)
698 epsd(i) = afiltr * dpdt + (one - afiltr) * epsd(i)
700 soundsp(i) = sqrt((bulk + four_over_3*g)/rho0(i))
707 IF (jthe < 0 .AND.
THEN
709 fheat(i) = fheat(i) + eta*(one-ft(i))*weitemp(i)*yld(i)*dpla(i)*volume(i)